diff options
| author | Rong Xu <xur@google.com> | 2014-07-21 16:47:22 -0700 |
|---|---|---|
| committer | Rong Xu <xur@google.com> | 2014-07-29 15:31:03 -0700 |
| commit | 38a8aecfb882072900434499696b5c32a2274515 (patch) | |
| tree | 2aac97f0ae24b03cd98c1a06e989c031c173f889 /gcc-4.9/gcc/fortran | |
| parent | c231900e5dcc14d8296bd9f62b45997a49d4d5e7 (diff) | |
| download | toolchain_gcc-38a8aecfb882072900434499696b5c32a2274515.tar.gz toolchain_gcc-38a8aecfb882072900434499696b5c32a2274515.tar.bz2 toolchain_gcc-38a8aecfb882072900434499696b5c32a2274515.zip | |
[4.9] Switch gcc-4.9 to use google/gcc-4_9 branch.
This source drop uses svn version r212828 of google/gcc-4.9 branch.
We also cherry-picked r213062, r213063 and r213064 to fix windows
build issues.
All gcc-4.9 patches before July 3rd are ported to google/gcc-4.9.
The following prior commits has not been merged to google branch yet.
(They are included in this commit).
e7af147f979e657fe2df00808e5b4319b0e088c6,
baf87df3cb2683649ba7e9872362a7e721117c23, and
c231900e5dcc14d8296bd9f62b45997a49d4d5e7.
Change-Id: I4bea3ea470387ff751c2be4cb0d4a12059b9299b
Diffstat (limited to 'gcc-4.9/gcc/fortran')
31 files changed, 6912 insertions, 19259 deletions
diff --git a/gcc-4.9/gcc/fortran/ChangeLog b/gcc-4.9/gcc/fortran/ChangeLog index 42f0321c5..b96c61224 100644 --- a/gcc-4.9/gcc/fortran/ChangeLog +++ b/gcc-4.9/gcc/fortran/ChangeLog @@ -1,3 +1,607 @@ +2014-07-07 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/61459 + PR fortran/58883 + * trans-expr.c (fcncall_realloc_result): Use the natural type + for the address expression of 'res_desc'. + +2014-07-07 Dominique d'Humieres <dominiq@lps.ens.fr> + Mikael Morin <mikael@gcc.gnu.org> + + PR fortran/41936 + * trans-expr.c (gfc_conv_expr_reference): Deallocate array + components. + +2014-07-02 Jakub Jelinek <jakub@redhat.com> + Fritz Reese <Reese-Fritz@zai.com> + + * decl.c (variable_decl): Reject old style initialization + for derived type components. + +2014-06-30 Jakub Jelinek <jakub@redhat.com> + + * module.c (MOD_VERSION): Revert back to 12. + (MOD_VERSION_OMP4): Define. + (module_omp4): New variable. + (mio_symbol): Call mio_omp_declare_simd only if module_omp4. + (read_module): Load omp udrs only if module_omp4. + (write_module): Write omp udrs only if module_omp4. + (find_omp_declare_simd): New function. + (gfc_dump_module): Compute module_omp4. Use MOD_VERSION_OMP4 + if module_omp4. + (gfc_use_module): Handle MOD_VERSION_OMP4, set module_omp4. + + Backported from mainline + 2014-06-25 Jakub Jelinek <jakub@redhat.com> + + * trans.h (gfc_omp_clause_linear_ctor): New prototype. + * trans-openmp.c (gfc_omp_linear_clause_add_loop, + gfc_omp_clause_linear_ctor): New functions. + (gfc_trans_omp_clauses): Make sure OMP_CLAUSE_LINEAR_STEP has + correct type. Set OMP_CLAUSE_LINEAR_ARRAY flag if needed. + * f95-lang.c (LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR): Redefine. + + 2014-06-24 Jakub Jelinek <jakub@redhat.com> + + * dump-parse-tree.c (show_omp_namelist): Use n->udr->udr instead + of n->udr. + * f95-lang.c (gfc_init_builtin_functions): Initialize + BUILT_IN_ASSUME_ALIGNED. + * gfortran.h (gfc_omp_namelist): Change udr field type to + struct gfc_omp_namelist_udr. + (gfc_omp_namelist_udr): New type. + (gfc_get_omp_namelist_udr): Define. + (gfc_resolve_code): New prototype. + * match.c (gfc_free_omp_namelist): Free name->udr. + * module.c (intrinsics): Add INTRINSIC_USER. + (fix_mio_expr): Likewise. + (mio_expr): Handle INSTRINSIC_USER and non-resolved EXPR_FUNCTION. + * openmp.c (gfc_match_omp_clauses): Adjust initialization of n->udr. + (gfc_match_omp_declare_reduction): Treat len=: the same as len=*. + Set attr.flavor on omp_{out,in,priv,orig} artificial variables. + (struct resolve_omp_udr_callback_data): New type. + (resolve_omp_udr_callback, resolve_omp_udr_callback2, + resolve_omp_udr_clause): New functions. + (resolve_omp_clauses): Adjust for n->udr changes, resolve UDR clauses + here. + (omp_udr_callback): Don't check for implicitly declared functions + here. + (gfc_resolve_omp_udr): Don't call gfc_resolve. Don't check for + implicitly declared subroutines here. + * resolve.c (resolve_function): If value.function.isym is non-NULL, + consider it already resolved. + (resolve_code): Renamed to ... + (gfc_resolve_code): ... this. No longer static. + (gfc_resolve_blocks, generate_component_assignments, resolve_codes): + Adjust callers. + * trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize + by reference type (C_PTR) variables. + (gfc_omp_finish_clause): Make sure OMP_CLAUSE_SIZE is non-NULL. + (gfc_trans_omp_udr_expr): Remove. + (gfc_trans_omp_array_reduction_or_udr): Adjust for n->udr changes. + Don't call gfc_trans_omp_udr_expr, even for sym->attr.dimension + expand it as assignment or subroutine call. Don't initialize + value.function.isym. + + 2014-06-18 Tobias Burnus <burnus@net-b.de> + + * gfortran.texi (OpenMP): Update refs to OpenMP 4.0. + * intrinsic.texi (OpenMP Modules): Ditto. + + 2014-06-18 Jakub Jelinek <jakub@redhat.com> + + * cpp.c (cpp_define_builtins): Change _OPENMP macro to + 201307. + * dump-parse-tree.c (show_omp_namelist): Add list_type + argument. Adjust for rop being u.reduction_op now, + handle depend_op or map_op. + (show_omp_node): Adjust callers. Print some new + OpenMP 4.0 clauses, adjust for OMP_LIST_DEPEND_{IN,OUT} + becoming a single OMP_LIST_DEPEND. + * f95-lang.c (gfc_handle_omp_declare_target_attribute): New + function. + (gfc_attribute_table): New variable. + (LANG_HOOKS_OMP_FINISH_CLAUSE, LANG_HOOKS_ATTRIBUTE_TABLE): Redefine. + * frontend-passes.c (gfc_code_walker): Handle new OpenMP target + EXEC_OMP_* codes and new clauses. + * gfortran.h (gfc_statement): Add ST_OMP_TARGET, ST_OMP_END_TARGET, + ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA, ST_OMP_TARGET_UPDATE, + ST_OMP_DECLARE_TARGET, ST_OMP_TEAMS, ST_OMP_END_TEAMS, + ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE, ST_OMP_DISTRIBUTE_SIMD, + ST_OMP_END_DISTRIBUTE_SIMD, ST_OMP_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO, ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_TARGET_TEAMS, + ST_OMP_END_TARGET_TEAMS, ST_OMP_TEAMS_DISTRIBUTE, + ST_OMP_END_TEAMS_DISTRIBUTE, ST_OMP_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD and + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD. + (symbol_attribute): Add omp_declare_target field. + (gfc_omp_depend_op, gfc_omp_map_op): New enums. + (gfc_omp_namelist): Replace rop field with union + containing reduction_op, depend_op and map_op. + (OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): Remove. + (OMP_LIST_DEPEND, OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM): New. + (gfc_omp_clauses): Add num_teams, device, thread_limit, + dist_sched_kind, dist_chunk_size fields. + (gfc_common_head): Add omp_declare_target field. + (gfc_exec_op): Add EXEC_OMP_TARGET, EXEC_OMP_TARGET_DATA, + EXEC_OMP_TEAMS, EXEC_OMP_DISTRIBUTE, EXEC_OMP_DISTRIBUTE_SIMD, + EXEC_OMP_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS, EXEC_OMP_TEAMS_DISTRIBUTE, + EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD and + EXEC_OMP_TARGET_UPDATE. + (gfc_add_omp_declare_target): New prototype. + * match.h (gfc_match_omp_declare_target, gfc_match_omp_distribute, + gfc_match_omp_distribute_parallel_do, + gfc_match_omp_distribute_parallel_do_simd, + gfc_match_omp_distribute_simd, gfc_match_omp_target, + gfc_match_omp_target_data, gfc_match_omp_target_teams, + gfc_match_omp_target_teams_distribute, + gfc_match_omp_target_teams_distribute_parallel_do, + gfc_match_omp_target_teams_distribute_parallel_do_simd, + gfc_match_omp_target_teams_distribute_simd, + gfc_match_omp_target_update, gfc_match_omp_teams, + gfc_match_omp_teams_distribute, + gfc_match_omp_teams_distribute_parallel_do, + gfc_match_omp_teams_distribute_parallel_do_simd, + gfc_match_omp_teams_distribute_simd): New prototypes. + * module.c (ab_attribute): Add AB_OMP_DECLARE_TARGET. + (attr_bits): Likewise. + (mio_symbol_attribute): Handle omp_declare_target attribute. + (gfc_free_omp_clauses): Free num_teams, device, thread_limit + and dist_chunk_size expressions. + (OMP_CLAUSE_PRIVATE, OMP_CLAUSE_FIRSTPRIVATE, OMP_CLAUSE_LASTPRIVATE, + OMP_CLAUSE_COPYPRIVATE, OMP_CLAUSE_SHARED, OMP_CLAUSE_COPYIN, + OMP_CLAUSE_REDUCTION, OMP_CLAUSE_IF, OMP_CLAUSE_NUM_THREADS, + OMP_CLAUSE_SCHEDULE, OMP_CLAUSE_DEFAULT, OMP_CLAUSE_ORDERED, + OMP_CLAUSE_COLLAPSE, OMP_CLAUSE_UNTIED, OMP_CLAUSE_FINAL, + OMP_CLAUSE_MERGEABLE, OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, + OMP_CLAUSE_INBRANCH, OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, + OMP_CLAUSE_PROC_BIND, OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, + OMP_CLAUSE_UNIFORM): Use 1U instead of 1. + (OMP_CLAUSE_DEVICE, OMP_CLAUSE_MAP, OMP_CLAUSE_TO, OMP_CLAUSE_FROM, + OMP_CLAUSE_NUM_TEAMS, OMP_CLAUSE_THREAD_LIMIT, + OMP_CLAUSE_DIST_SCHEDULE): Define. + (gfc_match_omp_clauses): Change mask parameter to unsigned int. + Adjust for rop becoming u.reduction_op. Disallow inbranch with + notinbranch. For depend clause, always create OMP_LIST_DEPEND + and fill in u.depend_op. Handle num_teams, device, map, + to, from, thread_limit and dist_schedule clauses. + (OMP_DECLARE_SIMD_CLAUSES): Or in OMP_CLAUSE_INBRANCH and + OMP_CLAUSE_NOTINBRANCH. + (OMP_TARGET_CLAUSES, OMP_TARGET_DATA_CLAUSES, + OMP_TARGET_UPDATE_CLAUSES, OMP_TEAMS_CLAUSES, + OMP_DISTRIBUTE_CLAUSES): Define. + (match_omp): New function. + (gfc_match_omp_do, gfc_match_omp_do_simd, gfc_match_omp_parallel, + gfc_match_omp_parallel_do, gfc_match_omp_parallel_do_simd, + gfc_match_omp_parallel_sections, gfc_match_omp_parallel_workshare, + gfc_match_omp_sections, gfc_match_omp_simd, gfc_match_omp_single, + gfc_match_omp_task): Rewritten using match_omp. + (gfc_match_omp_threadprivate, gfc_match_omp_declare_reduction): + Diagnose if the directives are followed by unexpected junk. + (gfc_match_omp_distribute, gfc_match_omp_distribute_parallel_do, + gfc_match_omp_distribute_parallel_do_simd, + gfc_match_omp_distrbute_simd, gfc_match_omp_declare_target, + gfc_match_omp_target, gfc_match_omp_target_data, + gfc_match_omp_target_teams, gfc_match_omp_target_teams_distribute, + gfc_match_omp_target_teams_distribute_parallel_do, + gfc_match_omp_target_teams_distribute_parallel_do_simd, + gfc_match_omp_target_teams_distrbute_simd, gfc_match_omp_target_update, + gfc_match_omp_teams, gfc_match_omp_teams_distribute, + gfc_match_omp_teams_distribute_parallel_do, + gfc_match_omp_teams_distribute_parallel_do_simd, + gfc_match_omp_teams_distrbute_simd): New functions. + * openmp.c (resolve_omp_clauses): Adjust for + OMP_LIST_DEPEND_{IN,OUT} being changed to OMP_LIST_DEPEND. Handle + OMP_LIST_MAP, OMP_LIST_FROM, OMP_LIST_TO, num_teams, device, + dist_chunk_size and thread_limit. + (gfc_resolve_omp_parallel_blocks): Only put sharing clauses into + ctx.sharing_clauses. Call gfc_resolve_omp_do_blocks for various + new EXEC_OMP_* codes. + (resolve_omp_do): Handle various new EXEC_OMP_* codes. + (gfc_resolve_omp_directive): Likewise. + (gfc_resolve_omp_declare_simd): Add missing space to diagnostics. + * parse.c (decode_omp_directive): Handle parsing of OpenMP 4.0 + offloading related directives. + (case_executable): Add ST_OMP_TARGET_UPDATE. + (case_exec_markers): Add ST_OMP_TARGET*, ST_OMP_TEAMS*, + ST_OMP_DISTRIBUTE*. + (case_decl): Add ST_OMP_DECLARE_TARGET. + (gfc_ascii_statement): Handle new ST_OMP_* codes. + (parse_omp_do): Handle various new ST_OMP_* codes. + (parse_executable): Likewise. + * resolve.c (gfc_resolve_blocks): Handle various new EXEC_OMP_* + codes. + (resolve_code): Likewise. + (resolve_symbol): Change that !$OMP DECLARE TARGET variables + are saved. + * st.c (gfc_free_statement): Handle various new EXEC_OMP_* codes. + * symbol.c (check_conflict): Check omp_declare_target conflicts. + (gfc_add_omp_declare_target): New function. + (gfc_copy_attr): Copy omp_declare_target. + * trans.c (trans_code): Handle various new EXEC_OMP_* codes. + * trans-common.c (build_common_decl): Add "omp declare target" + attribute if needed. + * trans-decl.c (add_attributes_to_decl): Likewise. + * trans.h (gfc_omp_finish_clause): New prototype. + * trans-openmp.c (gfc_omp_finish_clause): New function. + (gfc_trans_omp_reduction_list): Adjust for rop being renamed + to u.reduction_op. + (gfc_trans_omp_clauses): Adjust for OMP_LIST_DEPEND_{IN,OUT} + change to OMP_LIST_DEPEND and fix up depend handling. + Handle OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM, num_teams, + thread_limit, device, dist_chunk_size and dist_sched_kind. + (gfc_trans_omp_do): Handle EXEC_OMP_DISTRIBUTE. + (GFC_OMP_SPLIT_DISTRIBUTE, GFC_OMP_SPLIT_TEAMS, + GFC_OMP_SPLIT_TARGET, GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_DISTRIBUTE, + GFC_OMP_MASK_TEAMS, GFC_OMP_MASK_TARGET, GFC_OMP_MASK_NUM): New. + (gfc_split_omp_clauses): Handle splitting of clauses for new + EXEC_OMP_* codes. + (gfc_trans_omp_do_simd): Add pblock argument, adjust for being + callable for combined constructs. + (gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_do_simd): Likewise. + (gfc_trans_omp_distribute, gfc_trans_omp_teams, + gfc_trans_omp_target, gfc_trans_omp_target_data, + gfc_trans_omp_target_update): New functions. + (gfc_trans_omp_directive): Adjust gfc_trans_omp_* callers, handle + new EXEC_OMP_* codes. + + 2014-06-10 Jakub Jelinek <jakub@redhat.com> + + PR fortran/60928 + * f95-lang.c (gfc_init_builtin_functions): Handle -fopenmp-simd + like -fopenmp. + * openmp.c (resolve_omp_clauses): Remove allocatable components + diagnostics. Add associate-name and intent(in) pointer + diagnostics for various clauses, diagnose procedure pointers in + reduction clause. + * parse.c (match_word_omp_simd): New function. + (matchs, matcho): New macros. + (decode_omp_directive): Change match macros to either matchs + or matcho. Handle -fopenmp-simd. + (next_free, next_fixed): Handle -fopenmp-simd like -fopenmp. + * scanner.c (skip_free_comments, skip_fixed_comments, include_line): + Likewise. + * trans-array.c (get_full_array_size): Rename to... + (gfc_full_array_size): ... this. No longer static. + (duplicate_allocatable): Adjust caller. Add NO_MEMCPY argument + and handle it. + (gfc_duplicate_allocatable, gfc_copy_allocatable_data): Adjust + duplicate_allocatable callers. + (gfc_duplicate_allocatable_nocopy): New function. + (structure_alloc_comps): Adjust g*_full_array_size and + duplicate_allocatable caller. + * trans-array.h (gfc_full_array_size, + gfc_duplicate_allocatable_nocopy): New prototypes. + * trans-common.c (create_common): Call gfc_finish_decl_attrs. + * trans-decl.c (gfc_finish_decl_attrs): New function. + (gfc_finish_var_decl, create_function_arglist, + gfc_get_fake_result_decl): Call it. + (gfc_allocate_lang_decl): If DECL_LANG_SPECIFIC is already allocated, + don't allocate it again. + (gfc_get_symbol_decl): Set GFC_DECL_ASSOCIATE_VAR_P on + associate-names. + * trans.h (gfc_finish_decl_attrs): New prototype. + (struct lang_decl): Add scalar_allocatable and scalar_pointer + bitfields. + (GFC_DECL_SCALAR_ALLOCATABLE, GFC_DECL_SCALAR_POINTER, + GFC_DECL_GET_SCALAR_ALLOCATABLE, GFC_DECL_GET_SCALAR_POINTER, + GFC_DECL_ASSOCIATE_VAR_P): Define. + (GFC_POINTER_TYPE_P): Remove. + * trans-openmp.c (gfc_omp_privatize_by_reference): Don't check + GFC_POINTER_TYPE_P, instead test GFC_DECL_GET_SCALAR_ALLOCATABLE, + GFC_DECL_GET_SCALAR_POINTER or GFC_DECL_CRAY_POINTEE on decl. + (gfc_omp_predetermined_sharing): Associate-names are predetermined. + (enum walk_alloc_comps): New. + (gfc_has_alloc_comps, gfc_omp_unshare_expr_r, gfc_omp_unshare_expr, + gfc_walk_alloc_comps): New functions. + (gfc_omp_private_outer_ref): Return true for scalar allocatables or + decls with allocatable components. + (gfc_omp_clause_default_ctor, gfc_omp_clause_copy_ctor, + gfc_omp_clause_assign_op, gfc_omp_clause_dtor): Fix up handling of + allocatables, handle also OMP_CLAUSE_REDUCTION, handle scalar + allocatables and decls with allocatable components. + (gfc_trans_omp_array_reduction_or_udr): Don't handle allocatable + arrays here. + (gfc_trans_omp_reduction_list): Call + gfc_trans_omp_array_reduction_or_udr even for allocatable scalars. + (gfc_trans_omp_do_simd): If -fno-openmp, just expand it as OMP_SIMD. + (gfc_trans_omp_parallel_do_simd): Likewise. + * trans-types.c (gfc_sym_type): Don't set GFC_POINTER_TYPE_P. + (gfc_get_derived_type): Call gfc_finish_decl_attrs. + + 2014-06-06 Jakub Jelinek <jakub@redhat.com> + + * dump-parse-tree.c (show_omp_namelist): Dump reduction + id in each list item. + (show_omp_node): Only handle OMP_LIST_REDUCTION, not + OMP_LIST_REDUCTION_FIRST .. OMP_LIST_REDUCTION_LAST. Don't + dump reduction id here. + * frontend-passes.c (dummy_code_callback): Renamed to... + (gfc_dummy_code_callback): ... this. No longer static. + (optimize_reduction): Use gfc_dummy_code_callback instead of + dummy_code_callback. + * gfortran.h (gfc_statement): Add ST_OMP_DECLARE_REDUCTION. + (symbol_attribute): Add omp_udr_artificial_var bitfield. + (gfc_omp_reduction_op): New enum. + (gfc_omp_namelist): Add rop and udr fields. + (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): Removed. + (OMP_LIST_REDUCTION): New. + (gfc_omp_udr): New type. + (gfc_get_omp_udr): Define. + (gfc_symtree): Add n.omp_udr field. + (gfc_namespace): Add omp_udr_root field, add omp_udr_ns bitfield. + (gfc_free_omp_udr, gfc_omp_udr_find, gfc_resolve_omp_udrs, + gfc_dummy_code_callback): New prototypes. + * match.h (gfc_match_omp_declare_reduction): New prototype. + * module.c (MOD_VERSION): Increase to 13. + (omp_declare_reduction_stmt): New array. + (mio_omp_udr_expr, write_omp_udr, write_omp_udrs, load_omp_udrs): + New functions. + (read_module): Read OpenMP user defined reductions. + (write_module): Write OpenMP user defined reductions. + * openmp.c: Include arith.h. + (gfc_free_omp_udr, gfc_find_omp_udr): New functions. + (gfc_match_omp_clauses): Handle user defined reductions. + Store reduction kind into gfc_omp_namelist instead of using + several OMP_LIST_* entries. + (match_udr_expr, gfc_omp_udr_predef, gfc_omp_udr_find, + gfc_match_omp_declare_reduction): New functions. + (resolve_omp_clauses): Adjust for reduction clauses being only + in OMP_LIST_REDUCTION list. Diagnose missing UDRs. + (struct omp_udr_callback_data): New type. + (omp_udr_callback, gfc_resolve_omp_udr, gfc_resolve_omp_udrs): New + functions. + * parse.c (decode_omp_directive): Handle !$omp declare reduction. + (case_decl): Add ST_OMP_DECLARE_REDUCTION. + (gfc_ascii_statement): Print ST_OMP_DECLARE_REDUCTION. + * resolve.c (resolve_fl_variable): Allow len=: or len=* on + sym->attr.omp_udr_artificial_var symbols. + (resolve_types): Call gfc_resolve_omp_udrs. + * symbol.c (gfc_get_uop): If gfc_current_ns->omp_udr_ns, + use parent ns instead of gfc_current_ns. + (gfc_get_sym_tree): Don't insert symbols into + namespaces with omp_udr_ns set. + (free_omp_udr_tree): New function. + (gfc_free_namespace): Call it. + * trans-openmp.c (struct omp_udr_find_orig_data): New type. + (omp_udr_find_orig, gfc_trans_omp_udr_expr): New functions. + (gfc_trans_omp_array_reduction): Renamed to... + (gfc_trans_omp_array_reduction_or_udr): ... this. Remove SYM + argument, instead pass gfc_omp_namelist pointer N. Handle + user defined reductions. + (gfc_trans_omp_reduction_list): Remove REDUCTION_CODE argument. + Handle user defined reductions and reduction ops in gfc_omp_namelist. + (gfc_trans_omp_clauses): Adjust for just a single OMP_LIST_REDUCTION + list. + (gfc_split_omp_clauses): Likewise. + + 2014-05-12 Tobias Burnus <burnus@net-b.de> + + PR fortran/60127 + * openmp.c (resolve_omp_do): Reject do concurrent loops. + + 2014-05-11 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_statement): Add ST_OMP_CANCEL, + ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, + ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and + ST_OMP_DECLARE_SIMD. + (gfc_omp_namelist): New typedef. + (gfc_get_omp_namelist): Define. + (OMP_LIST_UNIFORM, OMP_LIST_ALIGNED, OMP_LIST_LINEAR, + OMP_LIST_DEPEND_IN, OMP_LIST_DEPEND_OUT): New clause list kinds. + (gfc_omp_proc_bind_kind, gfc_omp_cancel_kind): New enums. + (gfc_omp_clauses): Change type of lists to gfc_omp_namelist *. + Add inbranch, notinbranch, cancel, proc_bind, safelen_expr and + simdlen_expr fields. + (gfc_omp_declare_simd): New typedef. + (gfc_get_omp_declare_simd): Define. + (gfc_namespace): Add omp_declare_simd field. + (gfc_exec_op): Add EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD and + EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_MASK, GFC_OMP_ATOMIC_SEQ_CST + and GFC_OMP_ATOMIC_SWAP. + (gfc_code): Change type of omp_namelist field to gfc_omp_namelist *. + (gfc_free_omp_namelist, gfc_free_omp_declare_simd, + gfc_free_omp_declare_simd_list, gfc_resolve_omp_declare_simd): New + prototypes. + * trans-stmt.h (gfc_trans_omp_declare_simd): New prototype. + * symbol.c (gfc_free_namespace): Call gfc_free_omp_declare_simd. + * openmp.c (gfc_free_omp_clauses): Free safelen_expr and + simdlen_expr. Use gfc_free_omp_namelist instead of + gfc_free_namelist. + (gfc_free_omp_declare_simd, gfc_free_omp_declare_simd_list): New + functions. + (gfc_match_omp_variable_list): Add end_colon, headp and + allow_sections arguments. Handle parsing of array sections. + Use *omp_namelist* instead of *namelist* data structure and + functions/macros. Allow termination at : character. + (OMP_CLAUSE_ALIGNED, OMP_CLAUSE_DEPEND, OMP_CLAUSE_INBRANCH, + OMP_CLAUSE_LINEAR, OMP_CLAUSE_NOTINBRANCH, OMP_CLAUSE_PROC_BIND, + OMP_CLAUSE_SAFELEN, OMP_CLAUSE_SIMDLEN, OMP_CLAUSE_UNIFORM): Define. + (gfc_match_omp_clauses): Change first and needs_space variables + into arguments with default values. Parse inbranch, notinbranch, + proc_bind, safelen, simdlen, uniform, linear, aligned and + depend clauses. + (OMP_PARALLEL_CLAUSES): Add OMP_CLAUSE_PROC_BIND. + (OMP_DECLARE_SIMD_CLAUSES, OMP_SIMD_CLAUSES): Define. + (OMP_TASK_CLAUSES): Add OMP_CLAUSE_DEPEND. + (gfc_match_omp_do_simd): New function. + (gfc_match_omp_flush): Use *omp_namelist* instead of *namelist* + data structure and functions/macros. + (gfc_match_omp_simd, gfc_match_omp_declare_simd, + gfc_match_omp_parallel_do_simd): New functions. + (gfc_match_omp_atomic): Handle seq_cst clause. Handle atomic swap. + (gfc_match_omp_taskgroup, gfc_match_omp_cancel_kind, + gfc_match_omp_cancel, gfc_match_omp_cancellation_point): New + functions. + (resolve_omp_clauses): Add where, omp_clauses and ns arguments. + Use *omp_namelist* instead of *namelist* data structure and + functions/macros. Resolve uniform, aligned, linear, depend, + safelen and simdlen clauses. + (resolve_omp_atomic): Adjust for GFC_OMP_ATOMIC_{MASK,SEQ_CST,SWAP} + addition, recognize atomic swap. + (gfc_resolve_omp_parallel_blocks): Use gfc_omp_namelist instead + of gfc_namelist. Handle EXEC_OMP_PARALLEL_DO_SIMD the same as + EXEC_OMP_PARALLEL_DO. + (gfc_resolve_do_iterator): Use *omp_namelist* instead of *namelist* + data structure and functions/macros. + (resolve_omp_do): Likewise. Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_resolve_omp_directive): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD and EXEC_OMP_CANCEL. Adjust + resolve_omp_clauses caller. + (gfc_resolve_omp_declare_simd): New function. + * parse.c (decode_omp_directive): Parse cancellation point, cancel, + declare simd, end do simd, end simd, end parallel do simd, + end taskgroup, parallel do simd, simd and taskgroup directives. + (case_executable): Add ST_OMP_CANCEL and ST_OMP_CANCELLATION_POINT. + (case_exec_markers): Add ST_OMP_TASKGROUP, case ST_OMP_SIMD, + ST_OMP_DO_SIMD and ST_OMP_PARALLEL_DO_SIMD. + (case_decl): Add ST_OMP_DECLARE_SIMD. + (gfc_ascii_statement): Handle ST_OMP_CANCEL, + ST_OMP_CANCELLATION_POINT, ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, + ST_OMP_SIMD, ST_OMP_END_SIMD, ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD, ST_OMP_END_PARALLEL_DO_SIMD and + ST_OMP_DECLARE_SIMD. + (parse_omp_do): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD and + ST_OMP_PARALLEL_DO_SIMD. + (parse_omp_atomic): Adjust for GFC_OMP_ATOMIC_* additions. + (parse_omp_structured_block): Handle ST_OMP_TASKGROUP and + ST_OMP_PARALLEL_DO_SIMD. + (parse_executable): Handle ST_OMP_SIMD, ST_OMP_DO_SIMD, + ST_OMP_PARALLEL_DO_SIMD and ST_OMP_TASKGROUP. + * trans-decl.c (gfc_get_extern_function_decl, + gfc_create_function_decl): Call gfc_trans_omp_declare_simd if + needed. + * frontend-passes.c (gfc_code_walker): Handle EXEC_OMP_SIMD, + EXEC_OMP_DO_SIMD and EXEC_OMP_PARALLEL_DO_SIMD. Walk + safelen_expr and simdlen_expr. Walk expressions in gfc_omp_namelist + of depend, aligned and linear clauses. + * match.c (match_exit_cycle): Handle EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD + and EXEC_OMP_PARALLEL_DO_SIMD. + (gfc_free_omp_namelist): New function. + * dump-parse-tree.c (show_namelist): Removed. + (show_omp_namelist): New function. + (show_omp_node): Handle OpenMP 4.0 additions. + (show_code_node): Handle EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_DO_SIMD, EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and + EXEC_OMP_TASKGROUP. + * match.h (gfc_match_omp_cancel, gfc_match_omp_cancellation_point, + gfc_match_omp_declare_simd, gfc_match_omp_do_simd, + gfc_match_omp_parallel_do_simd, gfc_match_omp_simd, + gfc_match_omp_taskgroup): New prototypes. + * trans-openmp.c (gfc_trans_omp_variable): Add declare_simd + argument, handle it. Allow current_function_decl to be NULL. + (gfc_trans_omp_variable_list): Add declare_simd argument, pass + it through to gfc_trans_omp_variable and disregard whether + sym is referenced if declare_simd is true. Work on gfc_omp_namelist + instead of gfc_namelist. + (gfc_trans_omp_reduction_list): Work on gfc_omp_namelist instead of + gfc_namelist. Adjust gfc_trans_omp_variable caller. + (gfc_trans_omp_clauses): Add declare_simd argument, pass it through + to gfc_trans_omp_variable{,_list} callers. Work on gfc_omp_namelist + instead of gfc_namelist. Handle inbranch, notinbranch, safelen, + simdlen, depend, uniform, linear, proc_bind and aligned clauses. + Handle cancel kind. + (gfc_trans_omp_atomic): Handle seq_cst clause, handle atomic swap, + adjust for GFC_OMP_ATOMIC_* changes. + (gfc_trans_omp_cancel, gfc_trans_omp_cancellation_point): New + functions. + (gfc_trans_omp_do): Add op argument, handle simd translation into + generic. + (GFC_OMP_SPLIT_SIMD, GFC_OMP_SPLIT_DO, GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_NUM, GFC_OMP_MASK_SIMD, GFC_OMP_MASK_DO, + GFC_OMP_MASK_PARALLEL): New. + (gfc_split_omp_clauses, gfc_trans_omp_do_simd): New functions. + (gfc_trans_omp_parallel_do): Rework to use gfc_split_omp_clauses. + (gfc_trans_omp_parallel_do_simd, gfc_trans_omp_taskgroup): New + functions. + (gfc_trans_omp_directive): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + Adjust gfc_trans_omp_do caller. + (gfc_trans_omp_declare_simd): New function. + * st.c (gfc_free_statement): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + For EXEC_OMP_FLUSH call gfc_free_omp_namelist instead of + gfc_free_namelist. + * module.c (omp_declare_simd_clauses): New variable. + (mio_omp_declare_simd): New function. + (mio_symbol): Call it. + * trans.c (trans_code): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + * resolve.c (gfc_resolve_blocks): Handle EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + (resolve_code): Handle EXEC_OMP_CANCEL, + EXEC_OMP_CANCELLATION_POINT, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_SIMD and EXEC_OMP_TASKGROUP. + (resolve_types): Call gfc_resolve_omp_declare_simd. + +2014-06-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + Backport from trunk. + PR fortran/45187 + * trans-decl.c (gfc_create_module_variable): Don't create + Cray-pointee decls twice. + +2014-06-09 Paul Thomas <pault@gcc.gnu.org> + + Backport from trunk. + PR fortran/61406 + * trans-stmt.c (trans_associate_var): Check that array + constructors are constant for direct reference. + +2014-06-05 Richard Biener <rguenther@suse.de> + + PR fortran/61418 + * gfortranspec.c (spec_file): Remove. + (find_spec_file): Likewise. + (lang_specific_driver): Do not look for specs file in -L + or append -specs command line argument. + (lang_specific_pre_link): Always %:include libgfortran.spec. + +2014-05-29 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/60834 + Backport from mainline + * frontend-passes.c (in_assoc_list): New variable. + (optimize_namespace): Initialize in_assoc_list + (combine_array_constructor): Don't try to combine + assoc lists. + (gfc_code_walker): Keep track of in_assoc_list. + +2014-05-26 Janne Blomqvist <jb@gcc.gnu.org> + + Backport from mainline + PR libfortran/61310 + * intrinsics.texi (CTIME): Remove mention of locale-dependent + behavior. + 2014-04-22 Tobias Burnus <burnus@net-b.de> Backport from mainline diff --git a/gcc-4.9/gcc/fortran/cpp.c b/gcc-4.9/gcc/fortran/cpp.c index 169599003..7fb8d1602 100644 --- a/gcc-4.9/gcc/fortran/cpp.c +++ b/gcc-4.9/gcc/fortran/cpp.c @@ -171,7 +171,7 @@ cpp_define_builtins (cpp_reader *pfile) cpp_define (pfile, "_LANGUAGE_FORTRAN=1"); if (gfc_option.gfc_flag_openmp) - cpp_define (pfile, "_OPENMP=201107"); + cpp_define (pfile, "_OPENMP=201307"); /* The defines below are necessary for the TARGET_* macros. diff --git a/gcc-4.9/gcc/fortran/decl.c b/gcc-4.9/gcc/fortran/decl.c index 4048ac913..eebecd59f 100644 --- a/gcc-4.9/gcc/fortran/decl.c +++ b/gcc-4.9/gcc/fortran/decl.c @@ -1997,6 +1997,13 @@ variable_decl (int elem) if (!gfc_notify_std (GFC_STD_GNU, "Old-style " "initialization at %C")) return MATCH_ERROR; + else if (gfc_current_state () == COMP_DERIVED) + { + gfc_error ("Invalid old style initialization for derived type " + "component at %C"); + m = MATCH_ERROR; + goto cleanup; + } return match_old_style_init (name); } diff --git a/gcc-4.9/gcc/fortran/dump-parse-tree.c b/gcc-4.9/gcc/fortran/dump-parse-tree.c index b1343bc2a..19f83a9ef 100644 --- a/gcc-4.9/gcc/fortran/dump-parse-tree.c +++ b/gcc-4.9/gcc/fortran/dump-parse-tree.c @@ -1016,11 +1016,60 @@ show_code (int level, gfc_code *c) } static void -show_namelist (gfc_namelist *n) +show_omp_namelist (int list_type, gfc_omp_namelist *n) { - for (; n->next; n = n->next) - fprintf (dumpfile, "%s,", n->sym->name); - fprintf (dumpfile, "%s", n->sym->name); + for (; n; n = n->next) + { + if (list_type == OMP_LIST_REDUCTION) + switch (n->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + fprintf (dumpfile, "%s:", + gfc_op2string ((gfc_intrinsic_op) n->u.reduction_op)); + break; + case OMP_REDUCTION_MAX: fputs ("max:", dumpfile); break; + case OMP_REDUCTION_MIN: fputs ("min:", dumpfile); break; + case OMP_REDUCTION_IAND: fputs ("iand:", dumpfile); break; + case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break; + case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break; + case OMP_REDUCTION_USER: + if (n->udr) + fprintf (dumpfile, "%s:", n->udr->udr->name); + break; + default: break; + } + else if (list_type == OMP_LIST_DEPEND) + switch (n->u.depend_op) + { + case OMP_DEPEND_IN: fputs ("in:", dumpfile); break; + case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break; + case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break; + default: break; + } + else if (list_type == OMP_LIST_MAP) + switch (n->u.map_op) + { + case OMP_MAP_ALLOC: fputs ("alloc:", dumpfile); break; + case OMP_MAP_TO: fputs ("to:", dumpfile); break; + case OMP_MAP_FROM: fputs ("from:", dumpfile); break; + case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break; + default: break; + } + fprintf (dumpfile, "%s", n->sym->name); + if (n->expr) + { + fputc (':', dumpfile); + show_expr (n->expr); + } + if (n->next) + fputc (',', dumpfile); + } } /* Show a single OpenMP directive node and everything underneath it @@ -1036,18 +1085,24 @@ show_omp_node (int level, gfc_code *c) { case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; case EXEC_OMP_BARRIER: name = "BARRIER"; break; + case EXEC_OMP_CANCEL: name = "CANCEL"; break; + case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; 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_DO_SIMD: name = "DO SIMD"; 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_DO_SIMD: name = "PARALLEL DO SIMD"; 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_SIMD: name = "SIMD"; break; case EXEC_OMP_SINGLE: name = "SINGLE"; break; case EXEC_OMP_TASK: name = "TASK"; break; + case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break; case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break; case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break; case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break; @@ -1057,11 +1112,16 @@ show_omp_node (int level, gfc_code *c) fprintf (dumpfile, "!$OMP %s", name); switch (c->op) { + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1076,7 +1136,7 @@ show_omp_node (int level, gfc_code *c) if (c->ext.omp_namelist) { fputs (" (", dumpfile); - show_namelist (c->ext.omp_namelist); + show_omp_namelist (OMP_LIST_NUM, c->ext.omp_namelist); fputc (')', dumpfile); } return; @@ -1091,6 +1151,23 @@ show_omp_node (int level, gfc_code *c) { int list_type; + switch (omp_clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + fputs (" PARALLEL", dumpfile); + break; + case OMP_CANCEL_SECTIONS: + fputs (" SECTIONS", dumpfile); + break; + case OMP_CANCEL_DO: + fputs (" DO", dumpfile); + break; + case OMP_CANCEL_TASKGROUP: + fputs (" TASKGROUP", dumpfile); + break; + } if (omp_clauses->if_expr) { fputs (" IF(", dumpfile); @@ -1156,45 +1233,83 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses->lists[list_type] != NULL && list_type != OMP_LIST_COPYPRIVATE) { - const char *type; - if (list_type >= OMP_LIST_REDUCTION_FIRST) + const char *type = NULL; + switch (list_type) { - switch (list_type) - { - case OMP_LIST_PLUS: type = "+"; break; - case OMP_LIST_MULT: type = "*"; break; - case OMP_LIST_SUB: type = "-"; break; - case OMP_LIST_AND: type = ".AND."; break; - case OMP_LIST_OR: type = ".OR."; break; - case OMP_LIST_EQV: type = ".EQV."; break; - case OMP_LIST_NEQV: type = ".NEQV."; break; - case OMP_LIST_MAX: type = "MAX"; break; - case OMP_LIST_MIN: type = "MIN"; break; - case OMP_LIST_IAND: type = "IAND"; break; - case OMP_LIST_IOR: type = "IOR"; break; - case OMP_LIST_IEOR: type = "IEOR"; break; - default: - gcc_unreachable (); - } - fprintf (dumpfile, " REDUCTION(%s:", type); + 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; + case OMP_LIST_UNIFORM: type = "UNIFORM"; break; + case OMP_LIST_ALIGNED: type = "ALIGNED"; break; + case OMP_LIST_LINEAR: type = "LINEAR"; break; + case OMP_LIST_REDUCTION: type = "REDUCTION"; break; + case OMP_LIST_DEPEND: type = "DEPEND"; break; + default: + gcc_unreachable (); } - else - { - switch (list_type) - { - case OMP_LIST_PRIVATE: type = "PRIVATE"; break; - case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break; - case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break; - case OMP_LIST_SHARED: type = "SHARED"; break; - case OMP_LIST_COPYIN: type = "COPYIN"; break; - default: - gcc_unreachable (); - } - fprintf (dumpfile, " %s(", type); - } - show_namelist (omp_clauses->lists[list_type]); + fprintf (dumpfile, " %s(", type); + show_omp_namelist (list_type, omp_clauses->lists[list_type]); fputc (')', dumpfile); } + if (omp_clauses->safelen_expr) + { + fputs (" SAFELEN(", dumpfile); + show_expr (omp_clauses->safelen_expr); + fputc (')', dumpfile); + } + if (omp_clauses->simdlen_expr) + { + fputs (" SIMDLEN(", dumpfile); + show_expr (omp_clauses->simdlen_expr); + fputc (')', dumpfile); + } + if (omp_clauses->inbranch) + fputs (" INBRANCH", dumpfile); + if (omp_clauses->notinbranch) + fputs (" NOTINBRANCH", dumpfile); + if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + const char *type; + switch (omp_clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: type = "MASTER"; break; + case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break; + case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break; + default: + gcc_unreachable (); + } + fprintf (dumpfile, " PROC_BIND(%s)", type); + } + if (omp_clauses->num_teams) + { + fputs (" NUM_TEAMS(", dumpfile); + show_expr (omp_clauses->num_teams); + fputc (')', dumpfile); + } + if (omp_clauses->device) + { + fputs (" DEVICE(", dumpfile); + show_expr (omp_clauses->device); + fputc (')', dumpfile); + } + if (omp_clauses->thread_limit) + { + fputs (" THREAD_LIMIT(", dumpfile); + show_expr (omp_clauses->thread_limit); + fputc (')', dumpfile); + } + if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE) + { + fprintf (dumpfile, " DIST_SCHEDULE (static"); + if (omp_clauses->dist_chunk_size) + { + fputc (',', dumpfile); + show_expr (omp_clauses->dist_chunk_size); + } + fputc (')', dumpfile); + } } fputc ('\n', dumpfile); if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) @@ -1214,6 +1329,7 @@ show_omp_node (int level, gfc_code *c) show_code (level + 1, c->block->next); if (c->op == EXEC_OMP_ATOMIC) return; + fputc ('\n', dumpfile); code_indent (level, 0); fprintf (dumpfile, "!$OMP END %s", name); if (omp_clauses != NULL) @@ -1221,7 +1337,8 @@ show_omp_node (int level, gfc_code *c) if (omp_clauses->lists[OMP_LIST_COPYPRIVATE]) { fputs (" COPYPRIVATE(", dumpfile); - show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]); + show_omp_namelist (OMP_LIST_COPYPRIVATE, + omp_clauses->lists[OMP_LIST_COPYPRIVATE]); fputc (')', dumpfile); } else if (omp_clauses->nowait) @@ -2195,19 +2312,25 @@ show_code_node (int level, gfc_code *c) break; case EXEC_OMP_ATOMIC: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_BARRIER: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: case EXEC_OMP_WORKSHARE: diff --git a/gcc-4.9/gcc/fortran/f95-lang.c b/gcc-4.9/gcc/fortran/f95-lang.c index e25e92a55..12d323661 100644 --- a/gcc-4.9/gcc/fortran/f95-lang.c +++ b/gcc-4.9/gcc/fortran/f95-lang.c @@ -87,6 +87,24 @@ static alias_set_type gfc_get_alias_set (tree); static void gfc_init_ts (void); static tree gfc_builtin_function (tree); +/* Handle an "omp declare target" attribute; arguments as in + struct attribute_spec.handler. */ +static tree +gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *) +{ + return NULL_TREE; +} + +/* Table of valid Fortran attributes. */ +static const struct attribute_spec gfc_attribute_table[] = +{ + /* { name, min_len, max_len, decl_req, type_req, fn_type_req, handler, + affects_type_identity } */ + { "omp declare target", 0, 0, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, + { NULL, 0, 0, false, false, false, NULL, false } +}; + #undef LANG_HOOKS_NAME #undef LANG_HOOKS_INIT #undef LANG_HOOKS_FINISH @@ -108,7 +126,9 @@ static tree gfc_builtin_function (tree); #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP +#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR #undef LANG_HOOKS_OMP_CLAUSE_DTOR +#undef LANG_HOOKS_OMP_FINISH_CLAUSE #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF @@ -116,6 +136,7 @@ static tree gfc_builtin_function (tree); #undef LANG_HOOKS_BUILTIN_FUNCTION #undef LANG_HOOKS_BUILTIN_FUNCTION #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO +#undef LANG_HOOKS_ATTRIBUTE_TABLE /* Define lang hooks. */ #define LANG_HOOKS_NAME "GNU Fortran" @@ -138,14 +159,17 @@ static tree gfc_builtin_function (tree); #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op +#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor +#define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ gfc_omp_firstprivatize_type_sizes -#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function -#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info +#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function +#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info +#define LANG_HOOKS_ATTRIBUTE_TABLE gfc_attribute_table struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; @@ -1038,7 +1062,9 @@ gfc_init_builtin_functions (void) #include "../sync-builtins.def" #undef DEF_SYNC_BUILTIN - if (gfc_option.gfc_flag_openmp || flag_tree_parallelize_loops) + if (gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd + || flag_tree_parallelize_loops) { #undef DEF_GOMP_BUILTIN #define DEF_GOMP_BUILTIN(code, name, type, attr) \ @@ -1052,6 +1078,13 @@ gfc_init_builtin_functions (void) BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST); TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1; + ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node, + size_type_node, NULL_TREE); + gfc_define_builtin ("__builtin_assume_aligned", ftype, + BUILT_IN_ASSUME_ALIGNED, + "__builtin_assume_aligned", + ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__emutls_get_address", builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS, diff --git a/gcc-4.9/gcc/fortran/frontend-passes.c b/gcc-4.9/gcc/fortran/frontend-passes.c index 6c67e6610..4646cc33f 100644 --- a/gcc-4.9/gcc/fortran/frontend-passes.c +++ b/gcc-4.9/gcc/fortran/frontend-passes.c @@ -88,6 +88,10 @@ static int doloop_size, doloop_level; struct my_struct *evec; +/* Keep track of association lists. */ + +static bool in_assoc_list; + /* Entry point - run all passes for a namespace. */ void @@ -672,10 +676,10 @@ dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED, int *walk_subtrees, /* Dummy function for code callback, for use when we really don't want to do anything. */ -static int -dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED, - int *walk_subtrees ATTRIBUTE_UNUSED, - void *data ATTRIBUTE_UNUSED) +int +gfc_dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED, + int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) { return 0; } @@ -820,6 +824,7 @@ optimize_namespace (gfc_namespace *ns) current_ns = ns; forall_level = 0; iterator_level = 0; + in_assoc_list = false; in_omp_workshare = false; gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL); @@ -839,7 +844,8 @@ static void optimize_reduction (gfc_namespace *ns) { current_ns = ns; - gfc_code_walker (&ns->code, dummy_code_callback, callback_reduction, NULL); + gfc_code_walker (&ns->code, gfc_dummy_code_callback, + callback_reduction, NULL); /* BLOCKs are handled in the expression walker below. */ for (ns = ns->contained; ns; ns = ns->sibling) @@ -1054,6 +1060,11 @@ combine_array_constructor (gfc_expr *e) if (e->rank != 1) return false; + /* Don't try to combine association lists, this makes no sense + and leads to an ICE. */ + if (in_assoc_list) + return false; + op1 = e->value.op.op1; op2 = e->value.op.op2; @@ -1940,8 +1951,17 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, case EXEC_BLOCK: WALK_SUBCODE (co->ext.block.ns->code); - for (alist = co->ext.block.assoc; alist; alist = alist->next) - WALK_SUBEXPR (alist->target); + if (co->ext.block.assoc) + { + bool saved_in_assoc_list = in_assoc_list; + + in_assoc_list = true; + for (alist = co->ext.block.assoc; alist; alist = alist->next) + WALK_SUBEXPR (alist->target); + + in_assoc_list = saved_in_assoc_list; + } + break; case EXEC_DO: @@ -2112,6 +2132,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: in_omp_workshare = false; @@ -2126,12 +2147,31 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, in_omp_workshare = true; /* Fall through */ - + + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: case EXEC_OMP_END_SINGLE: + case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: /* Come to this label only from the EXEC_OMP_PARALLEL_* cases above. */ @@ -2140,10 +2180,27 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, if (co->ext.omp_clauses) { + gfc_omp_namelist *n; + static int list_types[] + = { OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND, + OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM }; + size_t idx; WALK_SUBEXPR (co->ext.omp_clauses->if_expr); WALK_SUBEXPR (co->ext.omp_clauses->final_expr); WALK_SUBEXPR (co->ext.omp_clauses->num_threads); WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); + WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); + WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams); + WALK_SUBEXPR (co->ext.omp_clauses->device); + WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); + WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); + for (idx = 0; + idx < sizeof (list_types) / sizeof (list_types[0]); + idx++) + for (n = co->ext.omp_clauses->lists[list_types[idx]]; + n; n = n->next) + WALK_SUBEXPR (n->expr); } break; default: diff --git a/gcc-4.9/gcc/fortran/gfortran.h b/gcc-4.9/gcc/fortran/gfortran.h index 14c202dd4..6b88aec38 100644 --- a/gcc-4.9/gcc/fortran/gfortran.h +++ b/gcc-4.9/gcc/fortran/gfortran.h @@ -211,8 +211,30 @@ typedef enum ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS, ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE, ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK, - ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, - ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE + ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT, + ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD, + ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD, + ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION, + ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA, + ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, + ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE, + ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD, + ST_OMP_DISTRIBUTE_PARALLEL_DO, ST_OMP_END_DISTRIBUTE_PARALLEL_DO, + ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_TEAMS, ST_OMP_END_TARGET_TEAMS, ST_OMP_TEAMS_DISTRIBUTE, + ST_OMP_END_TEAMS_DISTRIBUTE, ST_OMP_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TARGET_TEAMS_DISTRIBUTE, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE, ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD, ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, + ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_NONE } gfc_statement; @@ -808,6 +830,13 @@ typedef struct variable for SELECT_TYPE or ASSOCIATE. */ unsigned select_type_temporary:1, associate_var:1; + /* This is omp_{out,in,priv,orig} artificial variable in + !$OMP DECLARE REDUCTION. */ + unsigned omp_udr_artificial_var:1; + + /* Mentioned in OMP DECLARE TARGET. */ + unsigned omp_declare_target:1; + /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; @@ -1028,6 +1057,62 @@ gfc_namelist; #define gfc_get_namelist() XCNEW (gfc_namelist) +typedef enum +{ + OMP_REDUCTION_NONE = -1, + OMP_REDUCTION_PLUS = INTRINSIC_PLUS, + OMP_REDUCTION_MINUS = INTRINSIC_MINUS, + OMP_REDUCTION_TIMES = INTRINSIC_TIMES, + OMP_REDUCTION_AND = INTRINSIC_AND, + OMP_REDUCTION_OR = INTRINSIC_OR, + OMP_REDUCTION_EQV = INTRINSIC_EQV, + OMP_REDUCTION_NEQV = INTRINSIC_NEQV, + OMP_REDUCTION_MAX = GFC_INTRINSIC_END, + OMP_REDUCTION_MIN, + OMP_REDUCTION_IAND, + OMP_REDUCTION_IOR, + OMP_REDUCTION_IEOR, + OMP_REDUCTION_USER +} +gfc_omp_reduction_op; + +typedef enum +{ + OMP_DEPEND_IN, + OMP_DEPEND_OUT, + OMP_DEPEND_INOUT +} +gfc_omp_depend_op; + +typedef enum +{ + OMP_MAP_ALLOC, + OMP_MAP_TO, + OMP_MAP_FROM, + OMP_MAP_TOFROM +} +gfc_omp_map_op; + +/* For use in OpenMP clauses in case we need extra information + (aligned clause alignment, linear clause step, etc.). */ + +typedef struct gfc_omp_namelist +{ + struct gfc_symbol *sym; + struct gfc_expr *expr; + union + { + gfc_omp_reduction_op reduction_op; + gfc_omp_depend_op depend_op; + gfc_omp_map_op map_op; + } u; + struct gfc_omp_namelist_udr *udr; + struct gfc_omp_namelist *next; +} +gfc_omp_namelist; + +#define gfc_get_omp_namelist() XCNEW (gfc_omp_namelist) + enum { OMP_LIST_PRIVATE, @@ -1036,20 +1121,14 @@ enum 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_UNIFORM, + OMP_LIST_ALIGNED, + OMP_LIST_LINEAR, + OMP_LIST_DEPEND, + OMP_LIST_MAP, + OMP_LIST_TO, + OMP_LIST_FROM, + OMP_LIST_REDUCTION, OMP_LIST_NUM }; @@ -1075,23 +1154,93 @@ enum gfc_omp_default_sharing OMP_DEFAULT_FIRSTPRIVATE }; +enum gfc_omp_proc_bind_kind +{ + OMP_PROC_BIND_UNKNOWN, + OMP_PROC_BIND_MASTER, + OMP_PROC_BIND_SPREAD, + OMP_PROC_BIND_CLOSE +}; + +enum gfc_omp_cancel_kind +{ + OMP_CANCEL_UNKNOWN, + OMP_CANCEL_PARALLEL, + OMP_CANCEL_SECTIONS, + OMP_CANCEL_DO, + OMP_CANCEL_TASKGROUP +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; struct gfc_expr *final_expr; struct gfc_expr *num_threads; - gfc_namelist *lists[OMP_LIST_NUM]; + gfc_omp_namelist *lists[OMP_LIST_NUM]; enum gfc_omp_sched_kind sched_kind; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; int collapse; bool nowait, ordered, untied, mergeable; + bool inbranch, notinbranch; + enum gfc_omp_cancel_kind cancel; + enum gfc_omp_proc_bind_kind proc_bind; + struct gfc_expr *safelen_expr; + struct gfc_expr *simdlen_expr; + struct gfc_expr *num_teams; + struct gfc_expr *device; + struct gfc_expr *thread_limit; + enum gfc_omp_sched_kind dist_sched_kind; + struct gfc_expr *dist_chunk_size; } gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) +/* Node in the linked list used for storing !$omp declare simd constructs. */ + +typedef struct gfc_omp_declare_simd +{ + struct gfc_omp_declare_simd *next; + locus where; /* Where the !$omp declare simd construct occurred. */ + + gfc_symbol *proc_name; + + gfc_omp_clauses *clauses; +} +gfc_omp_declare_simd; +#define gfc_get_omp_declare_simd() XCNEW (gfc_omp_declare_simd) + +typedef struct gfc_omp_udr +{ + struct gfc_omp_udr *next; + locus where; /* Where the !$omp declare reduction construct occurred. */ + + const char *name; + gfc_typespec ts; + gfc_omp_reduction_op rop; + + struct gfc_symbol *omp_out; + struct gfc_symbol *omp_in; + struct gfc_namespace *combiner_ns; + + struct gfc_symbol *omp_priv; + struct gfc_symbol *omp_orig; + struct gfc_namespace *initializer_ns; +} +gfc_omp_udr; +#define gfc_get_omp_udr() XCNEW (gfc_omp_udr) + +typedef struct gfc_omp_namelist_udr +{ + struct gfc_omp_udr *udr; + struct gfc_code *combiner; + struct gfc_code *initializer; +} +gfc_omp_namelist_udr; +#define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr) + /* The gfc_st_label structure is a BBT attached to a namespace that records the usage of statement labels within that space. */ @@ -1292,7 +1441,7 @@ struct gfc_undo_change_set typedef struct gfc_common_head { locus where; - char use_assoc, saved, threadprivate; + char use_assoc, saved, threadprivate, omp_declare_target; char name[GFC_MAX_SYMBOL_LEN + 1]; struct gfc_symbol *head; const char* binding_label; @@ -1368,6 +1517,7 @@ typedef struct gfc_symtree gfc_user_op *uop; gfc_common_head *common; gfc_typebound_proc *tb; + gfc_omp_udr *omp_udr; } n; } @@ -1398,6 +1548,8 @@ typedef struct gfc_namespace gfc_symtree *uop_root; /* Tree containing all the common blocks. */ gfc_symtree *common_root; + /* Tree containing all the OpenMP user defined reductions. */ + gfc_symtree *omp_udr_root; /* Tree containing type-bound procedures. */ gfc_symtree *tb_sym_root; @@ -1464,6 +1616,9 @@ typedef struct gfc_namespace /* A list of USE statements in this namespace. */ gfc_use_list *use_stmts; + /* Linked list of !$omp declare simd constructs. */ + struct gfc_omp_declare_simd *omp_declare_simd; + /* Set to 1 if namespace is a BLOCK DATA program unit. */ unsigned is_block_data:1; @@ -1480,6 +1635,9 @@ typedef struct gfc_namespace /* Set to 1 if symbols in this namespace should be 'construct entities', i.e. for BLOCK local variables. */ unsigned construct_entities:1; + + /* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */ + unsigned omp_udr_ns:1; } gfc_namespace; @@ -2111,16 +2269,31 @@ typedef enum EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT, EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT, - EXEC_OMP_TASKYIELD + EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT, + EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD, + EXEC_OMP_PARALLEL_DO_SIMD, EXEC_OMP_TARGET, EXEC_OMP_TARGET_DATA, + EXEC_OMP_TEAMS, EXEC_OMP_DISTRIBUTE, EXEC_OMP_DISTRIBUTE_SIMD, + EXEC_OMP_DISTRIBUTE_PARALLEL_DO, EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS, EXEC_OMP_TEAMS_DISTRIBUTE, + EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, EXEC_OMP_TARGET_TEAMS_DISTRIBUTE, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + EXEC_OMP_TARGET_UPDATE } gfc_exec_op; typedef enum { - GFC_OMP_ATOMIC_UPDATE, - GFC_OMP_ATOMIC_READ, - GFC_OMP_ATOMIC_WRITE, - GFC_OMP_ATOMIC_CAPTURE + GFC_OMP_ATOMIC_UPDATE = 0, + GFC_OMP_ATOMIC_READ = 1, + GFC_OMP_ATOMIC_WRITE = 2, + GFC_OMP_ATOMIC_CAPTURE = 3, + GFC_OMP_ATOMIC_MASK = 3, + GFC_OMP_ATOMIC_SEQ_CST = 4, + GFC_OMP_ATOMIC_SWAP = 8 } gfc_omp_atomic_op; @@ -2172,7 +2345,7 @@ typedef struct gfc_code gfc_entry_list *entry; gfc_omp_clauses *omp_clauses; const char *omp_name; - gfc_namelist *omp_namelist; + gfc_omp_namelist *omp_namelist; bool omp_bool; gfc_omp_atomic_op omp_atomic; } @@ -2573,6 +2746,7 @@ bool gfc_add_protected (symbol_attribute *, const char *, locus *); bool gfc_add_result (symbol_attribute *, const char *, locus *); bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *); bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); +bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *); bool gfc_add_saved_common (symbol_attribute *, locus *); bool gfc_add_target (symbol_attribute *, locus *); bool gfc_add_dummy (symbol_attribute *, const char *, locus *); @@ -2728,6 +2902,7 @@ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); void gfc_free_namelist (gfc_namelist *); +void gfc_free_omp_namelist (gfc_omp_namelist *); void gfc_free_equiv (gfc_equiv *); void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *); void gfc_free_data (gfc_data *); @@ -2739,10 +2914,16 @@ gfc_expr *gfc_get_parentheses (gfc_expr *); /* openmp.c */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; void gfc_free_omp_clauses (gfc_omp_clauses *); +void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); +void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); +void gfc_free_omp_udr (gfc_omp_udr *); +gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *); void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *); void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *); void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *); +void gfc_resolve_omp_declare_simd (gfc_namespace *); +void gfc_resolve_omp_udrs (gfc_symtree *); void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *); void gfc_omp_restore_state (struct gfc_omp_saved_state *); @@ -2833,6 +3014,7 @@ void gfc_free_association_list (gfc_association_list *); /* resolve.c */ bool gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); +void gfc_resolve_code (gfc_code *, gfc_namespace *); void gfc_resolve_blocks (gfc_code *, gfc_namespace *); int gfc_impure_variable (gfc_symbol *); int gfc_pure (gfc_symbol *); @@ -3019,6 +3201,7 @@ void gfc_run_passes (gfc_namespace *); typedef int (*walk_code_fn_t) (gfc_code **, int *, void *); typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *); +int gfc_dummy_code_callback (gfc_code **, int *, void *); int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *); int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *); diff --git a/gcc-4.9/gcc/fortran/gfortran.info b/gcc-4.9/gcc/fortran/gfortran.info deleted file mode 100644 index b894d0d0f..000000000 --- a/gcc-4.9/gcc/fortran/gfortran.info +++ /dev/null @@ -1,18449 +0,0 @@ -This is gfortran.info, produced by makeinfo version 5.1 from -gfortran.texi. - -Copyright (C) 1999-2014 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "Funding Free Software", the Front-Cover Texts -being (a) (see below), and with the Back-Cover Texts being (b) (see -below). A copy of the license is included in the section entitled "GNU -Free Documentation License". - - (a) The FSF's Front-Cover Text is: - - A GNU Manual - - (b) The FSF's Back-Cover Text is: - - You have freedom to copy and modify this GNU Manual, like GNU -software. Copies published by the Free Software Foundation raise funds -for GNU development. -INFO-DIR-SECTION Software development -START-INFO-DIR-ENTRY -* gfortran: (gfortran). The GNU Fortran Compiler. -END-INFO-DIR-ENTRY - - This file documents the use and the internals of the GNU Fortran -compiler, ('gfortran'). - - Published by the Free Software Foundation 51 Franklin Street, Fifth -Floor Boston, MA 02110-1301 USA - - Copyright (C) 1999-2014 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "Funding Free Software", the Front-Cover Texts -being (a) (see below), and with the Back-Cover Texts being (b) (see -below). A copy of the license is included in the section entitled "GNU -Free Documentation License". - - (a) The FSF's Front-Cover Text is: - - A GNU Manual - - (b) The FSF's Back-Cover Text is: - - You have freedom to copy and modify this GNU Manual, like GNU -software. Copies published by the Free Software Foundation raise funds -for GNU development. - - -File: gfortran.info, Node: Top, Next: Introduction, Up: (dir) - -Introduction -************ - -This manual documents the use of 'gfortran', the GNU Fortran compiler. -You can find in this manual how to invoke 'gfortran', as well as its -features and incompatibilities. - -* Menu: - -* Introduction:: - -Part I: Invoking GNU Fortran -* Invoking GNU Fortran:: Command options supported by 'gfortran'. -* Runtime:: Influencing runtime behavior with environment variables. - -Part II: Language Reference -* Fortran 2003 and 2008 status:: Fortran 2003 and 2008 features supported by GNU Fortran. -* Compiler Characteristics:: User-visible implementation details. -* Extensions:: Language extensions implemented by GNU Fortran. -* Mixed-Language Programming:: Interoperability with C -* Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran. -* Intrinsic Modules:: Intrinsic modules supported by GNU Fortran. - -* Contributing:: How you can help. -* Copying:: GNU General Public License says - how you can copy and share GNU Fortran. -* GNU Free Documentation License:: - How you can copy and share this manual. -* Funding:: How to help assure continued work for free software. -* Option Index:: Index of command line options -* Keyword Index:: Index of concepts - - -File: gfortran.info, Node: Introduction, Next: Invoking GNU Fortran, Prev: Top, Up: Top - -1 Introduction -************** - -The GNU Fortran compiler front end was designed initially as a free -replacement for, or alternative to, the Unix 'f95' command; 'gfortran' -is the command you will use to invoke the compiler. - -* Menu: - -* About GNU Fortran:: What you should know about the GNU Fortran compiler. -* GNU Fortran and GCC:: You can compile Fortran, C, or other programs. -* Preprocessing and conditional compilation:: The Fortran preprocessor -* GNU Fortran and G77:: Why we chose to start from scratch. -* Project Status:: Status of GNU Fortran, roadmap, proposed extensions. -* Standards:: Standards supported by GNU Fortran. - - -File: gfortran.info, Node: About GNU Fortran, Next: GNU Fortran and GCC, Up: Introduction - -1.1 About GNU Fortran -===================== - -The GNU Fortran compiler supports the Fortran 77, 90 and 95 standards -completely, parts of the Fortran 2003 and Fortran 2008 standards, and -several vendor extensions. The development goal is to provide the -following features: - - * Read a user's program, stored in a file and containing instructions - written in Fortran 77, Fortran 90, Fortran 95, Fortran 2003 or - Fortran 2008. This file contains "source code". - - * Translate the user's program into instructions a computer can carry - out more quickly than it takes to translate the instructions in the - first place. The result after compilation of a program is "machine - code", code designed to be efficiently translated and processed by - a machine such as your computer. Humans usually are not as good - writing machine code as they are at writing Fortran (or C++, Ada, - or Java), because it is easy to make tiny mistakes writing machine - code. - - * Provide the user with information about the reasons why the - compiler is unable to create a binary from the source code. - Usually this will be the case if the source code is flawed. The - Fortran 90 standard requires that the compiler can point out - mistakes to the user. An incorrect usage of the language causes an - "error message". - - The compiler will also attempt to diagnose cases where the user's - program contains a correct usage of the language, but instructs the - computer to do something questionable. This kind of diagnostics - message is called a "warning message". - - * Provide optional information about the translation passes from the - source code to machine code. This can help a user of the compiler - to find the cause of certain bugs which may not be obvious in the - source code, but may be more easily found at a lower level compiler - output. It also helps developers to find bugs in the compiler - itself. - - * Provide information in the generated machine code that can make it - easier to find bugs in the program (using a debugging tool, called - a "debugger", such as the GNU Debugger 'gdb'). - - * Locate and gather machine code already generated to perform actions - requested by statements in the user's program. This machine code - is organized into "modules" and is located and "linked" to the user - program. - - The GNU Fortran compiler consists of several components: - - * A version of the 'gcc' command (which also might be installed as - the system's 'cc' command) that also understands and accepts - Fortran source code. The 'gcc' command is the "driver" program for - all the languages in the GNU Compiler Collection (GCC); With 'gcc', - you can compile the source code of any language for which a front - end is available in GCC. - - * The 'gfortran' command itself, which also might be installed as the - system's 'f95' command. 'gfortran' is just another driver program, - but specifically for the Fortran compiler only. The difference - with 'gcc' is that 'gfortran' will automatically link the correct - libraries to your program. - - * A collection of run-time libraries. These libraries contain the - machine code needed to support capabilities of the Fortran language - that are not directly provided by the machine code generated by the - 'gfortran' compilation phase, such as intrinsic functions and - subroutines, and routines for interaction with files and the - operating system. - - * The Fortran compiler itself, ('f951'). This is the GNU Fortran - parser and code generator, linked to and interfaced with the GCC - backend library. 'f951' "translates" the source code to assembler - code. You would typically not use this program directly; instead, - the 'gcc' or 'gfortran' driver programs will call it for you. - - -File: gfortran.info, Node: GNU Fortran and GCC, Next: Preprocessing and conditional compilation, Prev: About GNU Fortran, Up: Introduction - -1.2 GNU Fortran and GCC -======================= - -GNU Fortran is a part of GCC, the "GNU Compiler Collection". GCC -consists of a collection of front ends for various languages, which -translate the source code into a language-independent form called -"GENERIC". This is then processed by a common middle end which provides -optimization, and then passed to one of a collection of back ends which -generate code for different computer architectures and operating -systems. - - Functionally, this is implemented with a driver program ('gcc') which -provides the command-line interface for the compiler. It calls the -relevant compiler front-end program (e.g., 'f951' for Fortran) for each -file in the source code, and then calls the assembler and linker as -appropriate to produce the compiled output. In a copy of GCC which has -been compiled with Fortran language support enabled, 'gcc' will -recognize files with '.f', '.for', '.ftn', '.f90', '.f95', '.f03' and -'.f08' extensions as Fortran source code, and compile it accordingly. A -'gfortran' driver program is also provided, which is identical to 'gcc' -except that it automatically links the Fortran runtime libraries into -the compiled program. - - Source files with '.f', '.for', '.fpp', '.ftn', '.F', '.FOR', '.FPP', -and '.FTN' extensions are treated as fixed form. Source files with -'.f90', '.f95', '.f03', '.f08', '.F90', '.F95', '.F03' and '.F08' -extensions are treated as free form. The capitalized versions of either -form are run through preprocessing. Source files with the lower case -'.fpp' extension are also run through preprocessing. - - This manual specifically documents the Fortran front end, which -handles the programming language's syntax and semantics. The aspects of -GCC which relate to the optimization passes and the back-end code -generation are documented in the GCC manual; see *note Introduction: -(gcc)Top. The two manuals together provide a complete reference for the -GNU Fortran compiler. - - -File: gfortran.info, Node: Preprocessing and conditional compilation, Next: GNU Fortran and G77, Prev: GNU Fortran and GCC, Up: Introduction - -1.3 Preprocessing and conditional compilation -============================================= - -Many Fortran compilers including GNU Fortran allow passing the source -code through a C preprocessor (CPP; sometimes also called the Fortran -preprocessor, FPP) to allow for conditional compilation. In the case of -GNU Fortran, this is the GNU C Preprocessor in the traditional mode. On -systems with case-preserving file names, the preprocessor is -automatically invoked if the filename extension is '.F', '.FOR', '.FTN', -'.fpp', '.FPP', '.F90', '.F95', '.F03' or '.F08'. To manually invoke -the preprocessor on any file, use '-cpp', to disable preprocessing on -files where the preprocessor is run automatically, use '-nocpp'. - - If a preprocessed file includes another file with the Fortran -'INCLUDE' statement, the included file is not preprocessed. To -preprocess included files, use the equivalent preprocessor statement -'#include'. - - If GNU Fortran invokes the preprocessor, '__GFORTRAN__' is defined -and '__GNUC__', '__GNUC_MINOR__' and '__GNUC_PATCHLEVEL__' can be used -to determine the version of the compiler. See *note Overview: (cpp)Top. -for details. - - While CPP is the de-facto standard for preprocessing Fortran code, -Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines -Conditional Compilation, which is not widely used and not directly -supported by the GNU Fortran compiler. You can use the program coco to -preprocess such files (<http://www.daniellnagle.com/coco.html>). - - -File: gfortran.info, Node: GNU Fortran and G77, Next: Project Status, Prev: Preprocessing and conditional compilation, Up: Introduction - -1.4 GNU Fortran and G77 -======================= - -The GNU Fortran compiler is the successor to 'g77', the Fortran 77 front -end included in GCC prior to version 4. It is an entirely new program -that has been designed to provide Fortran 95 support and extensibility -for future Fortran language standards, as well as providing backwards -compatibility for Fortran 77 and nearly all of the GNU language -extensions supported by 'g77'. - - -File: gfortran.info, Node: Project Status, Next: Standards, Prev: GNU Fortran and G77, Up: Introduction - -1.5 Project Status -================== - - As soon as 'gfortran' can parse all of the statements correctly, it - will be in the "larva" state. When we generate code, the "puppa" - state. When 'gfortran' is done, we'll see if it will be a - beautiful butterfly, or just a big bug.... - - -Andy Vaught, April 2000 - - The start of the GNU Fortran 95 project was announced on the GCC -homepage in March 18, 2000 (even though Andy had already been working on -it for a while, of course). - - The GNU Fortran compiler is able to compile nearly all -standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, -including a number of standard and non-standard extensions, and can be -used on real-world programs. In particular, the supported extensions -include OpenMP, Cray-style pointers, and several Fortran 2003 and -Fortran 2008 features, including TR 15581. However, it is still under -development and has a few remaining rough edges. - - At present, the GNU Fortran compiler passes the NIST Fortran 77 Test -Suite (http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html), and -produces acceptable results on the LAPACK Test Suite -(http://www.netlib.org/lapack/faq.html#1.21). It also provides -respectable performance on the Polyhedron Fortran compiler benchmarks -(http://www.polyhedron.com/pb05.html) and the Livermore Fortran Kernels -test (http://www.llnl.gov/asci_benchmarks/asci/limited/lfk/README.html). -It has been used to compile a number of large real-world programs, -including the HIRLAM weather-forecasting code -(http://mysite.verizon.net/serveall/moene.pdf) and the Tonto quantum -chemistry package (http://www.theochem.uwa.edu.au/tonto/); see -<http://gcc.gnu.org/wiki/GfortranApps> for an extended list. - - Among other things, the GNU Fortran compiler is intended as a -replacement for G77. At this point, nearly all programs that could be -compiled with G77 can be compiled with GNU Fortran, although there are a -few minor known regressions. - - The primary work remaining to be done on GNU Fortran falls into three -categories: bug fixing (primarily regarding the treatment of invalid -code and providing useful error messages), improving the compiler -optimizations and the performance of compiled code, and extending the -compiler to support future standards--in particular, Fortran 2003 and -Fortran 2008. - - -File: gfortran.info, Node: Standards, Prev: Project Status, Up: Introduction - -1.6 Standards -============= - -* Menu: - -* Varying Length Character Strings:: - -The GNU Fortran compiler implements ISO/IEC 1539:1997 (Fortran 95). As -such, it can also compile essentially all standard-compliant Fortran 90 -and Fortran 77 programs. It also supports the ISO/IEC TR-15581 -enhancements to allocatable arrays. - - GNU Fortran also have a partial support for ISO/IEC 1539-1:2004 -(Fortran 2003), ISO/IEC 1539-1:2010 (Fortran 2008), the Technical -Specification 'Further Interoperability of Fortran with C' (ISO/IEC TS -29113:2012). Full support of those standards and future Fortran -standards is planned. The current status of the support is can be found -in the *note Fortran 2003 status::, *note Fortran 2008 status:: and -*note TS 29113 status:: sections of the documentation. - - Additionally, the GNU Fortran compilers supports the OpenMP -specification (version 3.1, -<http://openmp.org/wp/openmp-specifications/>). - - -File: gfortran.info, Node: Varying Length Character Strings, Up: Standards - -1.6.1 Varying Length Character Strings --------------------------------------- - -The Fortran 95 standard specifies in Part 2 (ISO/IEC 1539-2:2000) -varying length character strings. While GNU Fortran currently does not -support such strings directly, there exist two Fortran implementations -for them, which work with GNU Fortran. They can be found at -<http://www.fortran.com/iso_varying_string.f95> and at -<ftp://ftp.nag.co.uk/sc22wg5/ISO_VARYING_STRING/>. - - Deferred-length character strings of Fortran 2003 supports part of -the features of 'ISO_VARYING_STRING' and should be considered as -replacement. (Namely, allocatable or pointers of the type -'character(len=:)'.) - - -File: gfortran.info, Node: Invoking GNU Fortran, Next: Runtime, Prev: Introduction, Up: Top - -2 GNU Fortran Command Options -***************************** - -The 'gfortran' command supports all the options supported by the 'gcc' -command. Only options specific to GNU Fortran are documented here. - - *Note GCC Command Options: (gcc)Invoking GCC, for information on the -non-Fortran-specific aspects of the 'gcc' command (and, therefore, the -'gfortran' command). - - All GCC and GNU Fortran options are accepted both by 'gfortran' and -by 'gcc' (as well as any other drivers built at the same time, such as -'g++'), since adding GNU Fortran to the GCC distribution enables -acceptance of GNU Fortran options by all of the relevant drivers. - - In some cases, options have positive and negative forms; the negative -form of '-ffoo' would be '-fno-foo'. This manual documents only one of -these two forms, whichever one is not the default. - -* Menu: - -* Option Summary:: Brief list of all 'gfortran' options, - without explanations. -* Fortran Dialect Options:: Controlling the variant of Fortran language - compiled. -* Preprocessing Options:: Enable and customize preprocessing. -* Error and Warning Options:: How picky should the compiler be? -* Debugging Options:: Symbol tables, measurements, and debugging dumps. -* Directory Options:: Where to find module files -* Link Options :: Influencing the linking step -* Runtime Options:: Influencing runtime behavior -* Code Gen Options:: Specifying conventions for function calls, data layout - and register usage. -* Environment Variables:: Environment variables that affect 'gfortran'. - - -File: gfortran.info, Node: Option Summary, Next: Fortran Dialect Options, Up: Invoking GNU Fortran - -2.1 Option summary -================== - -Here is a summary of all the options specific to GNU Fortran, grouped by -type. Explanations are in the following sections. - -_Fortran Language Options_ - *Note Options controlling Fortran dialect: Fortran Dialect Options. - -fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code - -fd-lines-as-comments -fdefault-double-8 -fdefault-integer-8 - -fdefault-real-8 -fdollar-ok -ffixed-line-length-N - -ffixed-line-length-none -ffree-form -ffree-line-length-N - -ffree-line-length-none -fimplicit-none -finteger-4-integer-8 - -fmax-identifier-length -fmodule-private -fno-fixed-form -fno-range-check - -fopenmp -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 - -freal-8-real-10 -freal-8-real-16 -freal-8-real-4 -std=STD - -_Preprocessing Options_ - *Note Enable and customize preprocessing: Preprocessing Options. - -A-QUESTION[=ANSWER] - -AQUESTION=ANSWER -C -CC -DMACRO[=DEFN] - -H -P - -UMACRO -cpp -dD -dI -dM -dN -dU -fworking-directory - -imultilib DIR - -iprefix FILE -iquote -isysroot DIR -isystem DIR -nocpp - -nostdinc - -undef - -_Error and Warning Options_ - *Note Options to request or suppress errors and warnings: Error and - Warning Options. - -Waliasing -Wall -Wampersand -Warray-bounds - -Wc-binding-type -Wcharacter-truncation - -Wconversion -Wfunction-elimination -Wimplicit-interface - -Wimplicit-procedure -Wintrinsic-shadow -Wintrinsics-std - -Wline-truncation -Wno-align-commons -Wno-tabs -Wreal-q-constant - -Wsurprising -Wunderflow -Wunused-parameter -Wrealloc-lhs -Wrealloc-lhs-all - -Wtarget-lifetime -fmax-errors=N -fsyntax-only -pedantic -pedantic-errors - -_Debugging Options_ - *Note Options for debugging your program or GNU Fortran: Debugging - Options. - -fbacktrace -fdump-fortran-optimized -fdump-fortran-original - -fdump-parse-tree -ffpe-trap=LIST -ffpe-summary=LIST - -_Directory Options_ - *Note Options for directory search: Directory Options. - -IDIR -JDIR -fintrinsic-modules-path DIR - -_Link Options_ - *Note Options for influencing the linking step: Link Options. - -static-libgfortran - -_Runtime Options_ - *Note Options for influencing runtime behavior: Runtime Options. - -fconvert=CONVERSION -fmax-subrecord-length=LENGTH - -frecord-marker=LENGTH -fsign-zero - -_Code Generation Options_ - *Note Options for code generation conventions: Code Gen Options. - -faggressive-function-elimination -fblas-matmul-limit=N - -fbounds-check -fcheck-array-temporaries - -fcheck=<ALL|ARRAY-TEMPS|BOUNDS|DO|MEM|POINTER|RECURSION> - -fcoarray=<NONE|SINGLE|LIB> -fexternal-blas -ff2c - -ffrontend-optimize - -finit-character=N -finit-integer=N -finit-local-zero - -finit-logical=<TRUE|FALSE> - -finit-real=<ZERO|INF|-INF|NAN|SNAN> - -fmax-array-constructor=N -fmax-stack-var-size=N - -fno-align-commons - -fno-automatic -fno-protect-parens -fno-underscoring - -fsecond-underscore -fpack-derived -frealloc-lhs -frecursive - -frepack-arrays -fshort-enums -fstack-arrays - - -File: gfortran.info, Node: Fortran Dialect Options, Next: Preprocessing Options, Prev: Option Summary, Up: Invoking GNU Fortran - -2.2 Options controlling Fortran dialect -======================================= - -The following options control the details of the Fortran dialect -accepted by the compiler: - -'-ffree-form' -'-ffixed-form' - Specify the layout used by the source file. The free form layout - was introduced in Fortran 90. Fixed form was traditionally used in - older Fortran programs. When neither option is specified, the - source form is determined by the file extension. - -'-fall-intrinsics' - This option causes all intrinsic procedures (including the - GNU-specific extensions) to be accepted. This can be useful with - '-std=f95' to force standard-compliance but get access to the full - range of intrinsics available with 'gfortran'. As a consequence, - '-Wintrinsics-std' will be ignored and no user-defined procedure - with the same name as any intrinsic will be called except when it - is explicitly declared 'EXTERNAL'. - -'-fd-lines-as-code' -'-fd-lines-as-comments' - Enable special treatment for lines beginning with 'd' or 'D' in - fixed form sources. If the '-fd-lines-as-code' option is given - they are treated as if the first column contained a blank. If the - '-fd-lines-as-comments' option is given, they are treated as - comment lines. - -'-fdollar-ok' - Allow '$' as a valid non-first character in a symbol name. Symbols - that start with '$' are rejected since it is unclear which rules to - apply to implicit typing as different vendors implement different - rules. Using '$' in 'IMPLICIT' statements is also rejected. - -'-fbackslash' - Change the interpretation of backslashes in string literals from a - single backslash character to "C-style" escape characters. The - following combinations are expanded '\a', '\b', '\f', '\n', '\r', - '\t', '\v', '\\', and '\0' to the ASCII characters alert, - backspace, form feed, newline, carriage return, horizontal tab, - vertical tab, backslash, and NUL, respectively. Additionally, - '\x'NN, '\u'NNNN and '\U'NNNNNNNN (where each N is a hexadecimal - digit) are translated into the Unicode characters corresponding to - the specified code points. All other combinations of a character - preceded by \ are unexpanded. - -'-fmodule-private' - Set the default accessibility of module entities to 'PRIVATE'. - Use-associated entities will not be accessible unless they are - explicitly declared as 'PUBLIC'. - -'-ffixed-line-length-N' - Set column after which characters are ignored in typical fixed-form - lines in the source file, and through which spaces are assumed (as - if padded to that length) after the ends of short fixed-form lines. - - Popular values for N include 72 (the standard and the default), 80 - (card image), and 132 (corresponding to "extended-source" options - in some popular compilers). N may also be 'none', meaning that the - entire line is meaningful and that continued character constants - never have implicit spaces appended to them to fill out the line. - '-ffixed-line-length-0' means the same thing as - '-ffixed-line-length-none'. - -'-ffree-line-length-N' - Set column after which characters are ignored in typical free-form - lines in the source file. The default value is 132. N may be - 'none', meaning that the entire line is meaningful. - '-ffree-line-length-0' means the same thing as - '-ffree-line-length-none'. - -'-fmax-identifier-length=N' - Specify the maximum allowed identifier length. Typical values are - 31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008). - -'-fimplicit-none' - Specify that no implicit typing is allowed, unless overridden by - explicit 'IMPLICIT' statements. This is the equivalent of adding - 'implicit none' to the start of every procedure. - -'-fcray-pointer' - Enable the Cray pointer extension, which provides C-like pointer - functionality. - -'-fopenmp' - Enable the OpenMP extensions. This includes OpenMP '!$omp' - directives in free form and 'c$omp', '*$omp' and '!$omp' directives - in fixed form, '!$' conditional compilation sentinels in free form - and 'c$', '*$' and '!$' sentinels in fixed form, and when linking - arranges for the OpenMP runtime library to be linked in. The - option '-fopenmp' implies '-frecursive'. - -'-fno-range-check' - Disable range checking on results of simplification of constant - expressions during compilation. For example, GNU Fortran will give - an error at compile time when simplifying 'a = 1. / 0'. With this - option, no error will be given and 'a' will be assigned the value - '+Infinity'. If an expression evaluates to a value outside of the - relevant range of ['-HUGE()':'HUGE()'], then the expression will be - replaced by '-Inf' or '+Inf' as appropriate. Similarly, 'DATA - i/Z'FFFFFFFF'/' will result in an integer overflow on most systems, - but with '-fno-range-check' the value will "wrap around" and 'i' - will be initialized to -1 instead. - -'-fdefault-integer-8' - Set the default integer and logical types to an 8 byte wide type. - This option also affects the kind of integer constants like '42'. - Unlike '-finteger-4-integer-8', it does not promote variables with - explicit kind declaration. - -'-fdefault-real-8' - Set the default real type to an 8 byte wide type. This option also - affects the kind of non-double real constants like '1.0', and does - promote the default width of 'DOUBLE PRECISION' to 16 bytes if - possible, unless '-fdefault-double-8' is given, too. Unlike - '-freal-4-real-8', it does not promote variables with explicit kind - declaration. - -'-fdefault-double-8' - Set the 'DOUBLE PRECISION' type to an 8 byte wide type. Do nothing - if this is already the default. If '-fdefault-real-8' is given, - 'DOUBLE PRECISION' would instead be promoted to 16 bytes if - possible, and '-fdefault-double-8' can be used to prevent this. - The kind of real constants like '1.d0' will not be changed by - '-fdefault-real-8' though, so also '-fdefault-double-8' does not - affect it. - -'-finteger-4-integer-8' - Promote all 'INTEGER(KIND=4)' entities to an 'INTEGER(KIND=8)' - entities. If 'KIND=8' is unavailable, then an error will be - issued. This option should be used with care and may not be - suitable for your codes. Areas of possible concern include calls - to external procedures, alignment in 'EQUIVALENCE' and/or 'COMMON', - generic interfaces, BOZ literal constant conversion, and I/O. - Inspection of the intermediate representation of the translated - Fortran code, produced by '-fdump-tree-original', is suggested. - -'-freal-4-real-8' -'-freal-4-real-10' -'-freal-4-real-16' -'-freal-8-real-4' -'-freal-8-real-10' -'-freal-8-real-16' - Promote all 'REAL(KIND=M)' entities to 'REAL(KIND=N)' entities. If - 'REAL(KIND=N)' is unavailable, then an error will be issued. All - other real kind types are unaffected by this option. These options - should be used with care and may not be suitable for your codes. - Areas of possible concern include calls to external procedures, - alignment in 'EQUIVALENCE' and/or 'COMMON', generic interfaces, BOZ - literal constant conversion, and I/O. Inspection of the - intermediate representation of the translated Fortran code, - produced by '-fdump-tree-original', is suggested. - -'-std=STD' - Specify the standard to which the program is expected to conform, - which may be one of 'f95', 'f2003', 'f2008', 'gnu', or 'legacy'. - The default value for STD is 'gnu', which specifies a superset of - the Fortran 95 standard that includes all of the extensions - supported by GNU Fortran, although warnings will be given for - obsolete extensions not recommended for use in new code. The - 'legacy' value is equivalent but without the warnings for obsolete - extensions, and may be useful for old non-standard programs. The - 'f95', 'f2003' and 'f2008' values specify strict conformance to the - Fortran 95, Fortran 2003 and Fortran 2008 standards, respectively; - errors are given for all extensions beyond the relevant language - standard, and warnings are given for the Fortran 77 features that - are permitted but obsolescent in later standards. '-std=f2008ts' - allows the Fortran 2008 standard including the additions of the - Technical Specification (TS) 29113 on Further Interoperability of - Fortran with C. - - -File: gfortran.info, Node: Preprocessing Options, Next: Error and Warning Options, Prev: Fortran Dialect Options, Up: Invoking GNU Fortran - -2.3 Enable and customize preprocessing -====================================== - -Preprocessor related options. See section *note Preprocessing and -conditional compilation:: for more detailed information on preprocessing -in 'gfortran'. - -'-cpp' -'-nocpp' - Enable preprocessing. The preprocessor is automatically invoked if - the file extension is '.fpp', '.FPP', '.F', '.FOR', '.FTN', '.F90', - '.F95', '.F03' or '.F08'. Use this option to manually enable - preprocessing of any kind of Fortran file. - - To disable preprocessing of files with any of the above listed - extensions, use the negative form: '-nocpp'. - - The preprocessor is run in traditional mode. Any restrictions of - the file-format, especially the limits on line length, apply for - preprocessed output as well, so it might be advisable to use the - '-ffree-line-length-none' or '-ffixed-line-length-none' options. - -'-dM' - Instead of the normal output, generate a list of ''#define'' - directives for all the macros defined during the execution of the - preprocessor, including predefined macros. This gives you a way of - finding out what is predefined in your version of the preprocessor. - Assuming you have no file 'foo.f90', the command - touch foo.f90; gfortran -cpp -E -dM foo.f90 - will show all the predefined macros. - -'-dD' - Like '-dM' except in two respects: it does not include the - predefined macros, and it outputs both the '#define' directives and - the result of preprocessing. Both kinds of output go to the - standard output file. - -'-dN' - Like '-dD', but emit only the macro names, not their expansions. - -'-dU' - Like 'dD' except that only macros that are expanded, or whose - definedness is tested in preprocessor directives, are output; the - output is delayed until the use or test of the macro; and - ''#undef'' directives are also output for macros tested but - undefined at the time. - -'-dI' - Output ''#include'' directives in addition to the result of - preprocessing. - -'-fworking-directory' - Enable generation of linemarkers in the preprocessor output that - will let the compiler know the current working directory at the - time of preprocessing. When this option is enabled, the - preprocessor will emit, after the initial linemarker, a second - linemarker with the current working directory followed by two - slashes. GCC will use this directory, when it is present in the - preprocessed input, as the directory emitted as the current working - directory in some debugging information formats. This option is - implicitly enabled if debugging information is enabled, but this - can be inhibited with the negated form '-fno-working-directory'. - If the '-P' flag is present in the command line, this option has no - effect, since no '#line' directives are emitted whatsoever. - -'-idirafter DIR' - Search DIR for include files, but do it after all directories - specified with '-I' and the standard system directories have been - exhausted. DIR is treated as a system include directory. If dir - begins with '=', then the '=' will be replaced by the sysroot - prefix; see '--sysroot' and '-isysroot'. - -'-imultilib DIR' - Use DIR as a subdirectory of the directory containing - target-specific C++ headers. - -'-iprefix PREFIX' - Specify PREFIX as the prefix for subsequent '-iwithprefix' options. - If the PREFIX represents a directory, you should include the final - ''/''. - -'-isysroot DIR' - This option is like the '--sysroot' option, but applies only to - header files. See the '--sysroot' option for more information. - -'-iquote DIR' - Search DIR only for header files requested with '#include "file"'; - they are not searched for '#include <file>', before all directories - specified by '-I' and before the standard system directories. If - DIR begins with '=', then the '=' will be replaced by the sysroot - prefix; see '--sysroot' and '-isysroot'. - -'-isystem DIR' - Search DIR for header files, after all directories specified by - '-I' but before the standard system directories. Mark it as a - system directory, so that it gets the same special treatment as is - applied to the standard system directories. If DIR begins with - '=', then the '=' will be replaced by the sysroot prefix; see - '--sysroot' and '-isysroot'. - -'-nostdinc' - Do not search the standard system directories for header files. - Only the directories you have specified with '-I' options (and the - directory of the current file, if appropriate) are searched. - -'-undef' - Do not predefine any system-specific or GCC-specific macros. The - standard predefined macros remain defined. - -'-APREDICATE=ANSWER' - Make an assertion with the predicate PREDICATE and answer ANSWER. - This form is preferred to the older form -A predicate(answer), - which is still supported, because it does not use shell special - characters. - -'-A-PREDICATE=ANSWER' - Cancel an assertion with the predicate PREDICATE and answer ANSWER. - -'-C' - Do not discard comments. All comments are passed through to the - output file, except for comments in processed directives, which are - deleted along with the directive. - - You should be prepared for side effects when using '-C'; it causes - the preprocessor to treat comments as tokens in their own right. - For example, comments appearing at the start of what would be a - directive line have the effect of turning that line into an - ordinary source line, since the first token on the line is no - longer a ''#''. - - Warning: this currently handles C-Style comments only. The - preprocessor does not yet recognize Fortran-style comments. - -'-CC' - Do not discard comments, including during macro expansion. This is - like '-C', except that comments contained within macros are also - passed through to the output file where the macro is expanded. - - In addition to the side-effects of the '-C' option, the '-CC' - option causes all C++-style comments inside a macro to be converted - to C-style comments. This is to prevent later use of that macro - from inadvertently commenting out the remainder of the source line. - The '-CC' option is generally used to support lint comments. - - Warning: this currently handles C- and C++-Style comments only. - The preprocessor does not yet recognize Fortran-style comments. - -'-DNAME' - Predefine name as a macro, with definition '1'. - -'-DNAME=DEFINITION' - The contents of DEFINITION are tokenized and processed as if they - appeared during translation phase three in a ''#define'' directive. - In particular, the definition will be truncated by embedded newline - characters. - - If you are invoking the preprocessor from a shell or shell-like - program you may need to use the shell's quoting syntax to protect - characters such as spaces that have a meaning in the shell syntax. - - If you wish to define a function-like macro on the command line, - write its argument list with surrounding parentheses before the - equals sign (if any). Parentheses are meaningful to most shells, - so you will need to quote the option. With sh and csh, - '-D'name(args...)=definition'' works. - - '-D' and '-U' options are processed in the order they are given on - the command line. All -imacros file and -include file options are - processed after all -D and -U options. - -'-H' - Print the name of each header file used, in addition to other - normal activities. Each name is indented to show how deep in the - ''#include'' stack it is. - -'-P' - Inhibit generation of linemarkers in the output from the - preprocessor. This might be useful when running the preprocessor - on something that is not C code, and will be sent to a program - which might be confused by the linemarkers. - -'-UNAME' - Cancel any previous definition of NAME, either built in or provided - with a '-D' option. - - -File: gfortran.info, Node: Error and Warning Options, Next: Debugging Options, Prev: Preprocessing Options, Up: Invoking GNU Fortran - -2.4 Options to request or suppress errors and warnings -====================================================== - -Errors are diagnostic messages that report that the GNU Fortran compiler -cannot compile the relevant piece of source code. The compiler will -continue to process the program in an attempt to report further errors -to aid in debugging, but will not produce any compiled output. - - Warnings are diagnostic messages that report constructions which are -not inherently erroneous but which are risky or suggest there is likely -to be a bug in the program. Unless '-Werror' is specified, they do not -prevent compilation of the program. - - You can request many specific warnings with options beginning '-W', -for example '-Wimplicit' to request warnings on implicit declarations. -Each of these specific warning options also has a negative form -beginning '-Wno-' to turn off warnings; for example, '-Wno-implicit'. -This manual lists only one of the two forms, whichever is not the -default. - - These options control the amount and kinds of errors and warnings -produced by GNU Fortran: - -'-fmax-errors=N' - Limits the maximum number of error messages to N, at which point - GNU Fortran bails out rather than attempting to continue processing - the source code. If N is 0, there is no limit on the number of - error messages produced. - -'-fsyntax-only' - Check the code for syntax errors, but do not actually compile it. - This will generate module files for each module present in the - code, but no other output file. - -'-pedantic' - Issue warnings for uses of extensions to Fortran 95. '-pedantic' - also applies to C-language constructs where they occur in GNU - Fortran source files, such as use of '\e' in a character constant - within a directive like '#include'. - - Valid Fortran 95 programs should compile properly with or without - this option. However, without this option, certain GNU extensions - and traditional Fortran features are supported as well. With this - option, many of them are rejected. - - Some users try to use '-pedantic' to check programs for - conformance. They soon find that it does not do quite what they - want--it finds some nonstandard practices, but not all. However, - improvements to GNU Fortran in this area are welcome. - - This should be used in conjunction with '-std=f95', '-std=f2003' or - '-std=f2008'. - -'-pedantic-errors' - Like '-pedantic', except that errors are produced rather than - warnings. - -'-Wall' - Enables commonly used warning options pertaining to usage that we - recommend avoiding and that we believe are easy to avoid. This - currently includes '-Waliasing', '-Wampersand', '-Wconversion', - '-Wsurprising', '-Wc-binding-type', '-Wintrinsics-std', - '-Wno-tabs', '-Wintrinsic-shadow', '-Wline-truncation', - '-Wtarget-lifetime', '-Wreal-q-constant' and '-Wunused'. - -'-Waliasing' - Warn about possible aliasing of dummy arguments. Specifically, it - warns if the same actual argument is associated with a dummy - argument with 'INTENT(IN)' and a dummy argument with 'INTENT(OUT)' - in a call with an explicit interface. - - The following example will trigger the warning. - interface - subroutine bar(a,b) - integer, intent(in) :: a - integer, intent(out) :: b - end subroutine - end interface - integer :: a - - call bar(a,a) - -'-Wampersand' - Warn about missing ampersand in continued character constants. The - warning is given with '-Wampersand', '-pedantic', '-std=f95', - '-std=f2003' and '-std=f2008'. Note: With no ampersand given in a - continued character constant, GNU Fortran assumes continuation at - the first non-comment, non-whitespace character after the ampersand - that initiated the continuation. - -'-Warray-temporaries' - Warn about array temporaries generated by the compiler. The - information generated by this warning is sometimes useful in - optimization, in order to avoid such temporaries. - -'-Wc-binding-type' - Warn if the a variable might not be C interoperable. In - particular, warn if the variable has been declared using an - intrinsic type with default kind instead of using a kind parameter - defined for C interoperability in the intrinsic 'ISO_C_Binding' - module. This option is implied by '-Wall'. - -'-Wcharacter-truncation' - Warn when a character assignment will truncate the assigned string. - -'-Wline-truncation' - Warn when a source code line will be truncated. This option is - implied by '-Wall'. - -'-Wconversion' - Warn about implicit conversions that are likely to change the value - of the expression after conversion. Implied by '-Wall'. - -'-Wconversion-extra' - Warn about implicit conversions between different types and kinds. - -'-Wextra' - Enables some warning options for usages of language features which - may be problematic. This currently includes '-Wcompare-reals' and - '-Wunused-parameter'. - -'-Wimplicit-interface' - Warn if a procedure is called without an explicit interface. Note - this only checks that an explicit interface is present. It does - not check that the declared interfaces are consistent across - program units. - -'-Wimplicit-procedure' - Warn if a procedure is called that has neither an explicit - interface nor has been declared as 'EXTERNAL'. - -'-Wintrinsics-std' - Warn if 'gfortran' finds a procedure named like an intrinsic not - available in the currently selected standard (with '-std') and - treats it as 'EXTERNAL' procedure because of this. - '-fall-intrinsics' can be used to never trigger this behavior and - always link to the intrinsic regardless of the selected standard. - -'-Wreal-q-constant' - Produce a warning if a real-literal-constant contains a 'q' - exponent-letter. - -'-Wsurprising' - Produce a warning when "suspicious" code constructs are - encountered. While technically legal these usually indicate that - an error has been made. - - This currently produces a warning under the following - circumstances: - - * An INTEGER SELECT construct has a CASE that can never be - matched as its lower value is greater than its upper value. - - * A LOGICAL SELECT construct has three CASE statements. - - * A TRANSFER specifies a source that is shorter than the - destination. - - * The type of a function result is declared more than once with - the same type. If '-pedantic' or standard-conforming mode is - enabled, this is an error. - - * A 'CHARACTER' variable is declared with negative length. - -'-Wtabs' - By default, tabs are accepted as whitespace, but tabs are not - members of the Fortran Character Set. For continuation lines, a - tab followed by a digit between 1 and 9 is supported. '-Wno-tabs' - will cause a warning to be issued if a tab is encountered. Note, - '-Wno-tabs' is active for '-pedantic', '-std=f95', '-std=f2003', - '-std=f2008' and '-Wall'. - -'-Wunderflow' - Produce a warning when numerical constant expressions are - encountered, which yield an UNDERFLOW during compilation. - -'-Wintrinsic-shadow' - Warn if a user-defined procedure or module procedure has the same - name as an intrinsic; in this case, an explicit interface or - 'EXTERNAL' or 'INTRINSIC' declaration might be needed to get calls - later resolved to the desired intrinsic/procedure. This option is - implied by '-Wall'. - -'-Wunused-dummy-argument' - Warn about unused dummy arguments. This option is implied by - '-Wall'. - -'-Wunused-parameter' - Contrary to 'gcc''s meaning of '-Wunused-parameter', 'gfortran''s - implementation of this option does not warn about unused dummy - arguments (see '-Wunused-dummy-argument'), but about unused - 'PARAMETER' values. '-Wunused-parameter' is not included in - '-Wall' but is implied by '-Wall -Wextra'. - -'-Walign-commons' - By default, 'gfortran' warns about any occasion of variables being - padded for proper alignment inside a 'COMMON' block. This warning - can be turned off via '-Wno-align-commons'. See also - '-falign-commons'. - -'-Wfunction-elimination' - Warn if any calls to functions are eliminated by the optimizations - enabled by the '-ffrontend-optimize' option. - -'-Wrealloc-lhs' - Warn when the compiler might insert code to for allocation or - reallocation of an allocatable array variable of intrinsic type in - intrinsic assignments. In hot loops, the Fortran 2003 reallocation - feature may reduce the performance. If the array is already - allocated with the correct shape, consider using a whole-array - array-spec (e.g. '(:,:,:)') for the variable on the left-hand side - to prevent the reallocation check. Note that in some cases the - warning is shown, even if the compiler will optimize reallocation - checks away. For instance, when the right-hand side contains the - same variable multiplied by a scalar. See also '-frealloc-lhs'. - -'-Wrealloc-lhs-all' - Warn when the compiler inserts code to for allocation or - reallocation of an allocatable variable; this includes scalars and - derived types. - -'-Wcompare-reals' - Warn when comparing real or complex types for equality or - inequality. This option is implied by '-Wextra'. - -'-Wtarget-lifetime' - Warn if the pointer in a pointer assignment might be longer than - the its target. This option is implied by '-Wall'. - -'-Wzerotrip' - Warn if a 'DO' loop is known to execute zero times at compile time. - This option is implied by '-Wall'. - -'-Werror' - Turns all warnings into errors. - - *Note Options to Request or Suppress Errors and Warnings: -(gcc)Warning Options, for information on more options offered by the GBE -shared by 'gfortran', 'gcc' and other GNU compilers. - - Some of these have no effect when compiling programs written in -Fortran. - - -File: gfortran.info, Node: Debugging Options, Next: Directory Options, Prev: Error and Warning Options, Up: Invoking GNU Fortran - -2.5 Options for debugging your program or GNU Fortran -===================================================== - -GNU Fortran has various special options that are used for debugging -either your program or the GNU Fortran compiler. - -'-fdump-fortran-original' - Output the internal parse tree after translating the source program - into internal representation. Only really useful for debugging the - GNU Fortran compiler itself. - -'-fdump-fortran-optimized' - Output the parse tree after front-end optimization. Only really - useful for debugging the GNU Fortran compiler itself. - -'-fdump-parse-tree' - Output the internal parse tree after translating the source program - into internal representation. Only really useful for debugging the - GNU Fortran compiler itself. This option is deprecated; use - '-fdump-fortran-original' instead. - -'-ffpe-trap=LIST' - Specify a list of floating point exception traps to enable. On - most systems, if a floating point exception occurs and the trap for - that exception is enabled, a SIGFPE signal will be sent and the - program being aborted, producing a core file useful for debugging. - LIST is a (possibly empty) comma-separated list of the following - exceptions: 'invalid' (invalid floating point operation, such as - 'SQRT(-1.0)'), 'zero' (division by zero), 'overflow' (overflow in a - floating point operation), 'underflow' (underflow in a floating - point operation), 'inexact' (loss of precision during operation), - and 'denormal' (operation performed on a denormal value). The - first five exceptions correspond to the five IEEE 754 exceptions, - whereas the last one ('denormal') is not part of the IEEE 754 - standard but is available on some common architectures such as x86. - - The first three exceptions ('invalid', 'zero', and 'overflow') - often indicate serious errors, and unless the program has - provisions for dealing with these exceptions, enabling traps for - these three exceptions is probably a good idea. - - Many, if not most, floating point operations incur loss of - precision due to rounding, and hence the 'ffpe-trap=inexact' is - likely to be uninteresting in practice. - - By default no exception traps are enabled. - -'-ffpe-summary=LIST' - Specify a list of floating-point exceptions, whose flag status is - printed to 'ERROR_UNIT' when invoking 'STOP' and 'ERROR STOP'. - LIST can be either 'none', 'all' or a comma-separated list of the - following exceptions: 'invalid', 'zero', 'overflow', 'underflow', - 'inexact' and 'denormal'. (See '-ffpe-trap' for a description of - the exceptions.) - - By default, a summary for all exceptions but 'inexact' is shown. - -'-fno-backtrace' - When a serious runtime error is encountered or a deadly signal is - emitted (segmentation fault, illegal instruction, bus error, - floating-point exception, and the other POSIX signals that have the - action 'core'), the Fortran runtime library tries to output a - backtrace of the error. '-fno-backtrace' disables the backtrace - generation. This option only has influence for compilation of the - Fortran main program. - - *Note Options for Debugging Your Program or GCC: (gcc)Debugging -Options, for more information on debugging options. - - -File: gfortran.info, Node: Directory Options, Next: Link Options, Prev: Debugging Options, Up: Invoking GNU Fortran - -2.6 Options for directory search -================================ - -These options affect how GNU Fortran searches for files specified by the -'INCLUDE' directive and where it searches for previously compiled -modules. - - It also affects the search paths used by 'cpp' when used to -preprocess Fortran source. - -'-IDIR' - These affect interpretation of the 'INCLUDE' directive (as well as - of the '#include' directive of the 'cpp' preprocessor). - - Also note that the general behavior of '-I' and 'INCLUDE' is pretty - much the same as of '-I' with '#include' in the 'cpp' preprocessor, - with regard to looking for 'header.gcc' files and other such - things. - - This path is also used to search for '.mod' files when previously - compiled modules are required by a 'USE' statement. - - *Note Options for Directory Search: (gcc)Directory Options, for - information on the '-I' option. - -'-JDIR' - This option specifies where to put '.mod' files for compiled - modules. It is also added to the list of directories to searched - by an 'USE' statement. - - The default is the current directory. - -'-fintrinsic-modules-path DIR' - This option specifies the location of pre-compiled intrinsic - modules, if they are not in the default location expected by the - compiler. - - -File: gfortran.info, Node: Link Options, Next: Runtime Options, Prev: Directory Options, Up: Invoking GNU Fortran - -2.7 Influencing the linking step -================================ - -These options come into play when the compiler links object files into -an executable output file. They are meaningless if the compiler is not -doing a link step. - -'-static-libgfortran' - On systems that provide 'libgfortran' as a shared and a static - library, this option forces the use of the static version. If no - shared version of 'libgfortran' was built when the compiler was - configured, this option has no effect. - - -File: gfortran.info, Node: Runtime Options, Next: Code Gen Options, Prev: Link Options, Up: Invoking GNU Fortran - -2.8 Influencing runtime behavior -================================ - -These options affect the runtime behavior of programs compiled with GNU -Fortran. - -'-fconvert=CONVERSION' - Specify the representation of data for unformatted files. Valid - values for conversion are: 'native', the default; 'swap', swap - between big- and little-endian; 'big-endian', use big-endian - representation for unformatted files; 'little-endian', use - little-endian representation for unformatted files. - - _This option has an effect only when used in the main program. The - 'CONVERT' specifier and the GFORTRAN_CONVERT_UNIT environment - variable override the default specified by '-fconvert'._ - -'-frecord-marker=LENGTH' - Specify the length of record markers for unformatted files. Valid - values for LENGTH are 4 and 8. Default is 4. _This is different - from previous versions of 'gfortran'_, which specified a default - record marker length of 8 on most systems. If you want to read or - write files compatible with earlier versions of 'gfortran', use - '-frecord-marker=8'. - -'-fmax-subrecord-length=LENGTH' - Specify the maximum length for a subrecord. The maximum permitted - value for length is 2147483639, which is also the default. Only - really useful for use by the gfortran testsuite. - -'-fsign-zero' - When enabled, floating point numbers of value zero with the sign - bit set are written as negative number in formatted output and - treated as negative in the 'SIGN' intrinsic. '-fno-sign-zero' does - not print the negative sign of zero values (or values rounded to - zero for I/O) and regards zero as positive number in the 'SIGN' - intrinsic for compatibility with Fortran 77. The default is - '-fsign-zero'. - - -File: gfortran.info, Node: Code Gen Options, Next: Environment Variables, Prev: Runtime Options, Up: Invoking GNU Fortran - -2.9 Options for code generation conventions -=========================================== - -These machine-independent options control the interface conventions used -in code generation. - - Most of them have both positive and negative forms; the negative form -of '-ffoo' would be '-fno-foo'. In the table below, only one of the -forms is listed--the one which is not the default. You can figure out -the other form by either removing 'no-' or adding it. - -'-fno-automatic' - Treat each program unit (except those marked as RECURSIVE) as if - the 'SAVE' statement were specified for every local variable and - array referenced in it. Does not affect common blocks. (Some - Fortran compilers provide this option under the name '-static' or - '-save'.) The default, which is '-fautomatic', uses the stack for - local variables smaller than the value given by - '-fmax-stack-var-size'. Use the option '-frecursive' to use no - static memory. - -'-ff2c' - Generate code designed to be compatible with code generated by - 'g77' and 'f2c'. - - The calling conventions used by 'g77' (originally implemented in - 'f2c') require functions that return type default 'REAL' to - actually return the C type 'double', and functions that return type - 'COMPLEX' to return the values via an extra argument in the calling - sequence that points to where to store the return value. Under the - default GNU calling conventions, such functions simply return their - results as they would in GNU C--default 'REAL' functions return the - C type 'float', and 'COMPLEX' functions return the GNU C type - 'complex'. Additionally, this option implies the - '-fsecond-underscore' option, unless '-fno-second-underscore' is - explicitly requested. - - This does not affect the generation of code that interfaces with - the 'libgfortran' library. - - _Caution:_ It is not a good idea to mix Fortran code compiled with - '-ff2c' with code compiled with the default '-fno-f2c' calling - conventions as, calling 'COMPLEX' or default 'REAL' functions - between program parts which were compiled with different calling - conventions will break at execution time. - - _Caution:_ This will break code which passes intrinsic functions of - type default 'REAL' or 'COMPLEX' as actual arguments, as the - library implementations use the '-fno-f2c' calling conventions. - -'-fno-underscoring' - Do not transform names of entities specified in the Fortran source - file by appending underscores to them. - - With '-funderscoring' in effect, GNU Fortran appends one underscore - to external names with no underscores. This is done to ensure - compatibility with code produced by many UNIX Fortran compilers. - - _Caution_: The default behavior of GNU Fortran is incompatible with - 'f2c' and 'g77', please use the '-ff2c' option if you want object - files compiled with GNU Fortran to be compatible with object code - created with these tools. - - Use of '-fno-underscoring' is not recommended unless you are - experimenting with issues such as integration of GNU Fortran into - existing system environments (vis-a`-vis existing libraries, tools, - and so on). - - For example, with '-funderscoring', and assuming other defaults - like '-fcase-lower' and that 'j()' and 'max_count()' are external - functions while 'my_var' and 'lvar' are local variables, a - statement like - I = J() + MAX_COUNT (MY_VAR, LVAR) - is implemented as something akin to: - i = j_() + max_count__(&my_var__, &lvar); - - With '-fno-underscoring', the same statement is implemented as: - - i = j() + max_count(&my_var, &lvar); - - Use of '-fno-underscoring' allows direct specification of - user-defined names while debugging and when interfacing GNU Fortran - code with other languages. - - Note that just because the names match does _not_ mean that the - interface implemented by GNU Fortran for an external name matches - the interface implemented by some other language for that same - name. That is, getting code produced by GNU Fortran to link to - code produced by some other compiler using this or any other method - can be only a small part of the overall solution--getting the code - generated by both compilers to agree on issues other than naming - can require significant effort, and, unlike naming disagreements, - linkers normally cannot detect disagreements in these other areas. - - Also, note that with '-fno-underscoring', the lack of appended - underscores introduces the very real possibility that a - user-defined external name will conflict with a name in a system - library, which could make finding unresolved-reference bugs quite - difficult in some cases--they might occur at program run time, and - show up only as buggy behavior at run time. - - In future versions of GNU Fortran we hope to improve naming and - linking issues so that debugging always involves using the names as - they appear in the source, even if the names as seen by the linker - are mangled to prevent accidental linking between procedures with - incompatible interfaces. - -'-fsecond-underscore' - By default, GNU Fortran appends an underscore to external names. - If this option is used GNU Fortran appends two underscores to names - with underscores and one underscore to external names with no - underscores. GNU Fortran also appends two underscores to internal - names with underscores to avoid naming collisions with external - names. - - This option has no effect if '-fno-underscoring' is in effect. It - is implied by the '-ff2c' option. - - Otherwise, with this option, an external name such as 'MAX_COUNT' - is implemented as a reference to the link-time external symbol - 'max_count__', instead of 'max_count_'. This is required for - compatibility with 'g77' and 'f2c', and is implied by use of the - '-ff2c' option. - -'-fcoarray=<KEYWORD>' - - 'none' - Disable coarray support; using coarray declarations and - image-control statements will produce a compile-time error. - (Default) - - 'single' - Single-image mode, i.e. 'num_images()' is always one. - - 'lib' - Library-based coarray parallelization; a suitable GNU Fortran - coarray library needs to be linked. - -'-fcheck=<KEYWORD>' - - Enable the generation of run-time checks; the argument shall be a - comma-delimited list of the following keywords. - - 'all' - Enable all run-time test of '-fcheck'. - - 'array-temps' - Warns at run time when for passing an actual argument a - temporary array had to be generated. The information - generated by this warning is sometimes useful in optimization, - in order to avoid such temporaries. - - Note: The warning is only printed once per location. - - 'bounds' - Enable generation of run-time checks for array subscripts and - against the declared minimum and maximum values. It also - checks array indices for assumed and deferred shape arrays - against the actual allocated bounds and ensures that all - string lengths are equal for character array constructors - without an explicit typespec. - - Some checks require that '-fcheck=bounds' is set for the - compilation of the main program. - - Note: In the future this may also include other forms of - checking, e.g., checking substring references. - - 'do' - Enable generation of run-time checks for invalid modification - of loop iteration variables. - - 'mem' - Enable generation of run-time checks for memory allocation. - Note: This option does not affect explicit allocations using - the 'ALLOCATE' statement, which will be always checked. - - 'pointer' - Enable generation of run-time checks for pointers and - allocatables. - - 'recursion' - Enable generation of run-time checks for recursively called - subroutines and functions which are not marked as recursive. - See also '-frecursive'. Note: This check does not work for - OpenMP programs and is disabled if used together with - '-frecursive' and '-fopenmp'. - -'-fbounds-check' - Deprecated alias for '-fcheck=bounds'. - -'-fcheck-array-temporaries' - Deprecated alias for '-fcheck=array-temps'. - -'-fmax-array-constructor=N' - This option can be used to increase the upper limit permitted in - array constructors. The code below requires this option to expand - the array at compile time. - - program test - implicit none - integer j - integer, parameter :: n = 100000 - integer, parameter :: i(n) = (/ (2*j, j = 1, n) /) - print '(10(I0,1X))', i - end program test - - _Caution: This option can lead to long compile times and - excessively large object files._ - - The default value for N is 65535. - -'-fmax-stack-var-size=N' - This option specifies the size in bytes of the largest array that - will be put on the stack; if the size is exceeded static memory is - used (except in procedures marked as RECURSIVE). Use the option - '-frecursive' to allow for recursive procedures which do not have a - RECURSIVE attribute or for parallel programs. Use '-fno-automatic' - to never use the stack. - - This option currently only affects local arrays declared with - constant bounds, and may not apply to all character variables. - Future versions of GNU Fortran may improve this behavior. - - The default value for N is 32768. - -'-fstack-arrays' - Adding this option will make the Fortran compiler put all local - arrays, even those of unknown size onto stack memory. If your - program uses very large local arrays it is possible that you will - have to extend your runtime limits for stack memory on some - operating systems. This flag is enabled by default at optimization - level '-Ofast'. - -'-fpack-derived' - This option tells GNU Fortran to pack derived type members as - closely as possible. Code compiled with this option is likely to - be incompatible with code compiled without this option, and may - execute slower. - -'-frepack-arrays' - In some circumstances GNU Fortran may pass assumed shape array - sections via a descriptor describing a noncontiguous area of - memory. This option adds code to the function prologue to repack - the data into a contiguous block at runtime. - - This should result in faster accesses to the array. However it can - introduce significant overhead to the function call, especially - when the passed data is noncontiguous. - -'-fshort-enums' - This option is provided for interoperability with C code that was - compiled with the '-fshort-enums' option. It will make GNU Fortran - choose the smallest 'INTEGER' kind a given enumerator set will fit - in, and give all its enumerators this kind. - -'-fexternal-blas' - This option will make 'gfortran' generate calls to BLAS functions - for some matrix operations like 'MATMUL', instead of using our own - algorithms, if the size of the matrices involved is larger than a - given limit (see '-fblas-matmul-limit'). This may be profitable if - an optimized vendor BLAS library is available. The BLAS library - will have to be specified at link time. - -'-fblas-matmul-limit=N' - Only significant when '-fexternal-blas' is in effect. Matrix - multiplication of matrices with size larger than (or equal to) N - will be performed by calls to BLAS functions, while others will be - handled by 'gfortran' internal algorithms. If the matrices - involved are not square, the size comparison is performed using the - geometric mean of the dimensions of the argument and result - matrices. - - The default value for N is 30. - -'-frecursive' - Allow indirect recursion by forcing all local arrays to be - allocated on the stack. This flag cannot be used together with - '-fmax-stack-var-size=' or '-fno-automatic'. - -'-finit-local-zero' -'-finit-integer=N' -'-finit-real=<ZERO|INF|-INF|NAN|SNAN>' -'-finit-logical=<TRUE|FALSE>' -'-finit-character=N' - The '-finit-local-zero' option instructs the compiler to initialize - local 'INTEGER', 'REAL', and 'COMPLEX' variables to zero, 'LOGICAL' - variables to false, and 'CHARACTER' variables to a string of null - bytes. Finer-grained initialization options are provided by the - '-finit-integer=N', '-finit-real=<ZERO|INF|-INF|NAN|SNAN>' (which - also initializes the real and imaginary parts of local 'COMPLEX' - variables), '-finit-logical=<TRUE|FALSE>', and '-finit-character=N' - (where N is an ASCII character value) options. These options do - not initialize - * allocatable arrays - * components of derived type variables - * variables that appear in an 'EQUIVALENCE' statement. - (These limitations may be removed in future releases). - - Note that the '-finit-real=nan' option initializes 'REAL' and - 'COMPLEX' variables with a quiet NaN. For a signalling NaN use - '-finit-real=snan'; note, however, that compile-time optimizations - may convert them into quiet NaN and that trapping needs to be - enabled (e.g. via '-ffpe-trap'). - - Finally, note that enabling any of the '-finit-*' options will - silence warnings that would have been emitted by '-Wuninitialized' - for the affected local variables. - -'-falign-commons' - By default, 'gfortran' enforces proper alignment of all variables - in a 'COMMON' block by padding them as needed. On certain - platforms this is mandatory, on others it increases performance. - If a 'COMMON' block is not declared with consistent data types - everywhere, this padding can cause trouble, and - '-fno-align-commons' can be used to disable automatic alignment. - The same form of this option should be used for all files that - share a 'COMMON' block. To avoid potential alignment issues in - 'COMMON' blocks, it is recommended to order objects from largest to - smallest. - -'-fno-protect-parens' - By default the parentheses in expression are honored for all - optimization levels such that the compiler does not do any - re-association. Using '-fno-protect-parens' allows the compiler to - reorder 'REAL' and 'COMPLEX' expressions to produce faster code. - Note that for the re-association optimization '-fno-signed-zeros' - and '-fno-trapping-math' need to be in effect. The parentheses - protection is enabled by default, unless '-Ofast' is given. - -'-frealloc-lhs' - An allocatable left-hand side of an intrinsic assignment is - automatically (re)allocated if it is either unallocated or has a - different shape. The option is enabled by default except when - '-std=f95' is given. See also '-Wrealloc-lhs'. - -'-faggressive-function-elimination' - Functions with identical argument lists are eliminated within - statements, regardless of whether these functions are marked 'PURE' - or not. For example, in - a = f(b,c) + f(b,c) - there will only be a single call to 'f'. This option only works if - '-ffrontend-optimize' is in effect. - -'-ffrontend-optimize' - This option performs front-end optimization, based on manipulating - parts the Fortran parse tree. Enabled by default by any '-O' - option. Optimizations enabled by this option include elimination - of identical function calls within expressions, removing - unnecessary calls to 'TRIM' in comparisons and assignments and - replacing 'TRIM(a)' with 'a(1:LEN_TRIM(a))'. It can be deselected - by specifying '-fno-frontend-optimize'. - - *Note Options for Code Generation Conventions: (gcc)Code Gen Options, -for information on more options offered by the GBE shared by 'gfortran', -'gcc', and other GNU compilers. - - -File: gfortran.info, Node: Environment Variables, Prev: Code Gen Options, Up: Invoking GNU Fortran - -2.10 Environment variables affecting 'gfortran' -=============================================== - -The 'gfortran' compiler currently does not make use of any environment -variables to control its operation above and beyond those that affect -the operation of 'gcc'. - - *Note Environment Variables Affecting GCC: (gcc)Environment -Variables, for information on environment variables. - - *Note Runtime::, for environment variables that affect the run-time -behavior of programs compiled with GNU Fortran. - - -File: gfortran.info, Node: Runtime, Next: Fortran 2003 and 2008 status, Prev: Invoking GNU Fortran, Up: Top - -3 Runtime: Influencing runtime behavior with environment variables -****************************************************************** - -The behavior of the 'gfortran' can be influenced by environment -variables. - - Malformed environment variables are silently ignored. - -* Menu: - -* TMPDIR:: Directory for scratch files -* GFORTRAN_STDIN_UNIT:: Unit number for standard input -* GFORTRAN_STDOUT_UNIT:: Unit number for standard output -* GFORTRAN_STDERR_UNIT:: Unit number for standard error -* GFORTRAN_UNBUFFERED_ALL:: Do not buffer I/O for all units. -* GFORTRAN_UNBUFFERED_PRECONNECTED:: Do not buffer I/O for preconnected units. -* GFORTRAN_SHOW_LOCUS:: Show location for runtime errors -* GFORTRAN_OPTIONAL_PLUS:: Print leading + where permitted -* GFORTRAN_DEFAULT_RECL:: Default record length for new files -* GFORTRAN_LIST_SEPARATOR:: Separator for list output -* GFORTRAN_CONVERT_UNIT:: Set endianness for unformatted I/O -* GFORTRAN_ERROR_BACKTRACE:: Show backtrace on run-time errors - - -File: gfortran.info, Node: TMPDIR, Next: GFORTRAN_STDIN_UNIT, Up: Runtime - -3.1 'TMPDIR'--Directory for scratch files -========================================= - -When opening a file with 'STATUS='SCRATCH'', GNU Fortran tries to create -the file in one of the potential directories by testing each directory -in the order below. - - 1. The environment variable 'TMPDIR', if it exists. - - 2. On the MinGW target, the directory returned by the 'GetTempPath' - function. Alternatively, on the Cygwin target, the 'TMP' and - 'TEMP' environment variables, if they exist, in that order. - - 3. The 'P_tmpdir' macro if it is defined, otherwise the directory - '/tmp'. - - -File: gfortran.info, Node: GFORTRAN_STDIN_UNIT, Next: GFORTRAN_STDOUT_UNIT, Prev: TMPDIR, Up: Runtime - -3.2 'GFORTRAN_STDIN_UNIT'--Unit number for standard input -========================================================= - -This environment variable can be used to select the unit number -preconnected to standard input. This must be a positive integer. The -default value is 5. - - -File: gfortran.info, Node: GFORTRAN_STDOUT_UNIT, Next: GFORTRAN_STDERR_UNIT, Prev: GFORTRAN_STDIN_UNIT, Up: Runtime - -3.3 'GFORTRAN_STDOUT_UNIT'--Unit number for standard output -=========================================================== - -This environment variable can be used to select the unit number -preconnected to standard output. This must be a positive integer. The -default value is 6. - - -File: gfortran.info, Node: GFORTRAN_STDERR_UNIT, Next: GFORTRAN_UNBUFFERED_ALL, Prev: GFORTRAN_STDOUT_UNIT, Up: Runtime - -3.4 'GFORTRAN_STDERR_UNIT'--Unit number for standard error -========================================================== - -This environment variable can be used to select the unit number -preconnected to standard error. This must be a positive integer. The -default value is 0. - - -File: gfortran.info, Node: GFORTRAN_UNBUFFERED_ALL, Next: GFORTRAN_UNBUFFERED_PRECONNECTED, Prev: GFORTRAN_STDERR_UNIT, Up: Runtime - -3.5 'GFORTRAN_UNBUFFERED_ALL'--Do not buffer I/O on all units -============================================================= - -This environment variable controls whether all I/O is unbuffered. If -the first letter is 'y', 'Y' or '1', all I/O is unbuffered. This will -slow down small sequential reads and writes. If the first letter is -'n', 'N' or '0', I/O is buffered. This is the default. - - -File: gfortran.info, Node: GFORTRAN_UNBUFFERED_PRECONNECTED, Next: GFORTRAN_SHOW_LOCUS, Prev: GFORTRAN_UNBUFFERED_ALL, Up: Runtime - -3.6 'GFORTRAN_UNBUFFERED_PRECONNECTED'--Do not buffer I/O on preconnected units -=============================================================================== - -The environment variable named 'GFORTRAN_UNBUFFERED_PRECONNECTED' -controls whether I/O on a preconnected unit (i.e. STDOUT or STDERR) is -unbuffered. If the first letter is 'y', 'Y' or '1', I/O is unbuffered. -This will slow down small sequential reads and writes. If the first -letter is 'n', 'N' or '0', I/O is buffered. This is the default. - - -File: gfortran.info, Node: GFORTRAN_SHOW_LOCUS, Next: GFORTRAN_OPTIONAL_PLUS, Prev: GFORTRAN_UNBUFFERED_PRECONNECTED, Up: Runtime - -3.7 'GFORTRAN_SHOW_LOCUS'--Show location for runtime errors -=========================================================== - -If the first letter is 'y', 'Y' or '1', filename and line numbers for -runtime errors are printed. If the first letter is 'n', 'N' or '0', do -not print filename and line numbers for runtime errors. The default is -to print the location. - - -File: gfortran.info, Node: GFORTRAN_OPTIONAL_PLUS, Next: GFORTRAN_DEFAULT_RECL, Prev: GFORTRAN_SHOW_LOCUS, Up: Runtime - -3.8 'GFORTRAN_OPTIONAL_PLUS'--Print leading + where permitted -============================================================= - -If the first letter is 'y', 'Y' or '1', a plus sign is printed where -permitted by the Fortran standard. If the first letter is 'n', 'N' or -'0', a plus sign is not printed in most cases. Default is not to print -plus signs. - - -File: gfortran.info, Node: GFORTRAN_DEFAULT_RECL, Next: GFORTRAN_LIST_SEPARATOR, Prev: GFORTRAN_OPTIONAL_PLUS, Up: Runtime - -3.9 'GFORTRAN_DEFAULT_RECL'--Default record length for new files -================================================================ - -This environment variable specifies the default record length, in bytes, -for files which are opened without a 'RECL' tag in the 'OPEN' statement. -This must be a positive integer. The default value is 1073741824 bytes -(1 GB). - - -File: gfortran.info, Node: GFORTRAN_LIST_SEPARATOR, Next: GFORTRAN_CONVERT_UNIT, Prev: GFORTRAN_DEFAULT_RECL, Up: Runtime - -3.10 'GFORTRAN_LIST_SEPARATOR'--Separator for list output -========================================================= - -This environment variable specifies the separator when writing -list-directed output. It may contain any number of spaces and at most -one comma. If you specify this on the command line, be sure to quote -spaces, as in - $ GFORTRAN_LIST_SEPARATOR=' , ' ./a.out - when 'a.out' is the compiled Fortran program that you want to run. -Default is a single space. - - -File: gfortran.info, Node: GFORTRAN_CONVERT_UNIT, Next: GFORTRAN_ERROR_BACKTRACE, Prev: GFORTRAN_LIST_SEPARATOR, Up: Runtime - -3.11 'GFORTRAN_CONVERT_UNIT'--Set endianness for unformatted I/O -================================================================ - -By setting the 'GFORTRAN_CONVERT_UNIT' variable, it is possible to -change the representation of data for unformatted files. The syntax for -the 'GFORTRAN_CONVERT_UNIT' variable is: - GFORTRAN_CONVERT_UNIT: mode | mode ';' exception | exception ; - mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ; - exception: mode ':' unit_list | unit_list ; - unit_list: unit_spec | unit_list unit_spec ; - unit_spec: INTEGER | INTEGER '-' INTEGER ; - The variable consists of an optional default mode, followed by a list -of optional exceptions, which are separated by semicolons from the -preceding default and each other. Each exception consists of a format -and a comma-separated list of units. Valid values for the modes are the -same as for the 'CONVERT' specifier: - - 'NATIVE' Use the native format. This is the default. - 'SWAP' Swap between little- and big-endian. - 'LITTLE_ENDIAN' Use the little-endian format for unformatted files. - 'BIG_ENDIAN' Use the big-endian format for unformatted files. - A missing mode for an exception is taken to mean 'BIG_ENDIAN'. -Examples of values for 'GFORTRAN_CONVERT_UNIT' are: - ''big_endian'' Do all unformatted I/O in big_endian mode. - ''little_endian;native:10-20,25'' Do all unformatted I/O in - little_endian mode, except for units 10 to 20 and 25, which are in - native format. - ''10-20'' Units 10 to 20 are big-endian, the rest is native. - - Setting the environment variables should be done on the command line -or via the 'export' command for 'sh'-compatible shells and via 'setenv' -for 'csh'-compatible shells. - - Example for 'sh': - $ gfortran foo.f90 - $ GFORTRAN_CONVERT_UNIT='big_endian;native:10-20' ./a.out - - Example code for 'csh': - % gfortran foo.f90 - % setenv GFORTRAN_CONVERT_UNIT 'big_endian;native:10-20' - % ./a.out - - Using anything but the native representation for unformatted data -carries a significant speed overhead. If speed in this area matters to -you, it is best if you use this only for data that needs to be portable. - - *Note CONVERT specifier::, for an alternative way to specify the data -representation for unformatted files. *Note Runtime Options::, for -setting a default data representation for the whole program. The -'CONVERT' specifier overrides the '-fconvert' compile options. - - _Note that the values specified via the GFORTRAN_CONVERT_UNIT -environment variable will override the CONVERT specifier in the open -statement_. This is to give control over data formats to users who do -not have the source code of their program available. - - -File: gfortran.info, Node: GFORTRAN_ERROR_BACKTRACE, Prev: GFORTRAN_CONVERT_UNIT, Up: Runtime - -3.12 'GFORTRAN_ERROR_BACKTRACE'--Show backtrace on run-time errors -================================================================== - -If the 'GFORTRAN_ERROR_BACKTRACE' variable is set to 'y', 'Y' or '1' -(only the first letter is relevant) then a backtrace is printed when a -serious run-time error occurs. To disable the backtracing, set the -variable to 'n', 'N', '0'. Default is to print a backtrace unless the -'-fno-backtrace' compile option was used. - - -File: gfortran.info, Node: Fortran 2003 and 2008 status, Next: Compiler Characteristics, Prev: Runtime, Up: Top - -4 Fortran 2003 and 2008 Status -****************************** - -* Menu: - -* Fortran 2003 status:: -* Fortran 2008 status:: -* TS 29113 status:: - - -File: gfortran.info, Node: Fortran 2003 status, Next: Fortran 2008 status, Up: Fortran 2003 and 2008 status - -4.1 Fortran 2003 status -======================= - -GNU Fortran supports several Fortran 2003 features; an incomplete list -can be found below. See also the wiki page -(http://gcc.gnu.org/wiki/Fortran2003) about Fortran 2003. - - * Procedure pointers including procedure-pointer components with - 'PASS' attribute. - - * Procedures which are bound to a derived type (type-bound - procedures) including 'PASS', 'PROCEDURE' and 'GENERIC', and - operators bound to a type. - - * Abstract interfaces and type extension with the possibility to - override type-bound procedures or to have deferred binding. - - * Polymorphic entities ("'CLASS'") for derived types and unlimited - polymorphism ("'CLASS(*)'") - including 'SAME_TYPE_AS', - 'EXTENDS_TYPE_OF' and 'SELECT TYPE' for scalars and arrays and - finalization. - - * Generic interface names, which have the same name as derived types, - are now supported. This allows one to write constructor functions. - Note that Fortran does not support static constructor functions. - For static variables, only default initialization or - structure-constructor initialization are available. - - * The 'ASSOCIATE' construct. - - * Interoperability with C including enumerations, - - * In structure constructors the components with default values may be - omitted. - - * Extensions to the 'ALLOCATE' statement, allowing for a - type-specification with type parameter and for allocation and - initialization from a 'SOURCE=' expression; 'ALLOCATE' and - 'DEALLOCATE' optionally return an error message string via - 'ERRMSG='. - - * Reallocation on assignment: If an intrinsic assignment is used, an - allocatable variable on the left-hand side is automatically - allocated (if unallocated) or reallocated (if the shape is - different). Currently, scalar deferred character length left-hand - sides are correctly handled but arrays are not yet fully - implemented. - - * Deferred-length character variables and scalar deferred-length - character components of derived types are supported. (Note that - array-valued compoents are not yet implemented.) - - * Transferring of allocations via 'MOVE_ALLOC'. - - * The 'PRIVATE' and 'PUBLIC' attributes may be given individually to - derived-type components. - - * In pointer assignments, the lower bound may be specified and the - remapping of elements is supported. - - * For pointers an 'INTENT' may be specified which affect the - association status not the value of the pointer target. - - * Intrinsics 'command_argument_count', 'get_command', - 'get_command_argument', and 'get_environment_variable'. - - * Support for Unicode characters (ISO 10646) and UTF-8, including the - 'SELECTED_CHAR_KIND' and 'NEW_LINE' intrinsic functions. - - * Support for binary, octal and hexadecimal (BOZ) constants in the - intrinsic functions 'INT', 'REAL', 'CMPLX' and 'DBLE'. - - * Support for namelist variables with allocatable and pointer - attribute and nonconstant length type parameter. - - * Array constructors using square brackets. That is, '[...]' rather - than '(/.../)'. Type-specification for array constructors like '(/ - some-type :: ... /)'. - - * Extensions to the specification and initialization expressions, - including the support for intrinsics with real and complex - arguments. - - * Support for the asynchronous input/output syntax; however, the data - transfer is currently always synchronously performed. - - * 'FLUSH' statement. - - * 'IOMSG=' specifier for I/O statements. - - * Support for the declaration of enumeration constants via the 'ENUM' - and 'ENUMERATOR' statements. Interoperability with 'gcc' is - guaranteed also for the case where the '-fshort-enums' command line - option is given. - - * TR 15581: - * 'ALLOCATABLE' dummy arguments. - * 'ALLOCATABLE' function results - * 'ALLOCATABLE' components of derived types - - * The 'OPEN' statement supports the 'ACCESS='STREAM'' specifier, - allowing I/O without any record structure. - - * Namelist input/output for internal files. - - * Minor I/O features: Rounding during formatted output, using of a - decimal comma instead of a decimal point, setting whether a plus - sign should appear for positive numbers. On system where 'strtod' - honours the rounding mode, the rounding mode is also supported for - input. - - * The 'PROTECTED' statement and attribute. - - * The 'VALUE' statement and attribute. - - * The 'VOLATILE' statement and attribute. - - * The 'IMPORT' statement, allowing to import host-associated derived - types. - - * The intrinsic modules 'ISO_FORTRAN_ENVIRONMENT' is supported, which - contains parameters of the I/O units, storage sizes. Additionally, - procedures for C interoperability are available in the - 'ISO_C_BINDING' module. - - * 'USE' statement with 'INTRINSIC' and 'NON_INTRINSIC' attribute; - supported intrinsic modules: 'ISO_FORTRAN_ENV', 'ISO_C_BINDING', - 'OMP_LIB' and 'OMP_LIB_KINDS'. - - * Renaming of operators in the 'USE' statement. - - -File: gfortran.info, Node: Fortran 2008 status, Next: TS 29113 status, Prev: Fortran 2003 status, Up: Fortran 2003 and 2008 status - -4.2 Fortran 2008 status -======================= - -The latest version of the Fortran standard is ISO/IEC 1539-1:2010, -informally known as Fortran 2008. The official version is available -from International Organization for Standardization (ISO) or its -national member organizations. The the final draft (FDIS) can be -downloaded free of charge from -<http://www.nag.co.uk/sc22wg5/links.html>. Fortran is developed by the -Working Group 5 of Sub-Committee 22 of the Joint Technical Committee 1 -of the International Organization for Standardization and the -International Electrotechnical Commission (IEC). This group is known as -WG5 (http://www.nag.co.uk/sc22wg5/). - - The GNU Fortran compiler supports several of the new features of -Fortran 2008; the wiki (http://gcc.gnu.org/wiki/Fortran2008Status) has -some information about the current Fortran 2008 implementation status. -In particular, the following is implemented. - - * The '-std=f2008' option and support for the file extensions '.f08' - and '.F08'. - - * The 'OPEN' statement now supports the 'NEWUNIT=' option, which - returns a unique file unit, thus preventing inadvertent use of the - same unit in different parts of the program. - - * The 'g0' format descriptor and unlimited format items. - - * The mathematical intrinsics 'ASINH', 'ACOSH', 'ATANH', 'ERF', - 'ERFC', 'GAMMA', 'LOG_GAMMA', 'BESSEL_J0', 'BESSEL_J1', - 'BESSEL_JN', 'BESSEL_Y0', 'BESSEL_Y1', 'BESSEL_YN', 'HYPOT', - 'NORM2', and 'ERFC_SCALED'. - - * Using complex arguments with 'TAN', 'SINH', 'COSH', 'TANH', 'ASIN', - 'ACOS', and 'ATAN' is now possible; 'ATAN'(Y,X) is now an alias for - 'ATAN2'(Y,X). - - * Support of the 'PARITY' intrinsic functions. - - * The following bit intrinsics: 'LEADZ' and 'TRAILZ' for counting the - number of leading and trailing zero bits, 'POPCNT' and 'POPPAR' for - counting the number of one bits and returning the parity; 'BGE', - 'BGT', 'BLE', and 'BLT' for bitwise comparisons; 'DSHIFTL' and - 'DSHIFTR' for combined left and right shifts, 'MASKL' and 'MASKR' - for simple left and right justified masks, 'MERGE_BITS' for a - bitwise merge using a mask, 'SHIFTA', 'SHIFTL' and 'SHIFTR' for - shift operations, and the transformational bit intrinsics 'IALL', - 'IANY' and 'IPARITY'. - - * Support of the 'EXECUTE_COMMAND_LINE' intrinsic subroutine. - - * Support for the 'STORAGE_SIZE' intrinsic inquiry function. - - * The 'INT{8,16,32}' and 'REAL{32,64,128}' kind type parameters and - the array-valued named constants 'INTEGER_KINDS', 'LOGICAL_KINDS', - 'REAL_KINDS' and 'CHARACTER_KINDS' of the intrinsic module - 'ISO_FORTRAN_ENV'. - - * The module procedures 'C_SIZEOF' of the intrinsic module - 'ISO_C_BINDINGS' and 'COMPILER_VERSION' and 'COMPILER_OPTIONS' of - 'ISO_FORTRAN_ENV'. - - * Coarray support for serial programs with '-fcoarray=single' flag - and experimental support for multiple images with the - '-fcoarray=lib' flag. - - * The 'DO CONCURRENT' construct is supported. - - * The 'BLOCK' construct is supported. - - * The 'STOP' and the new 'ERROR STOP' statements now support all - constant expressions. Both show the signals which were signaling - at termination. - - * Support for the 'CONTIGUOUS' attribute. - - * Support for 'ALLOCATE' with 'MOLD'. - - * Support for the 'IMPURE' attribute for procedures, which allows for - 'ELEMENTAL' procedures without the restrictions of 'PURE'. - - * Null pointers (including 'NULL()') and not-allocated variables can - be used as actual argument to optional non-pointer, non-allocatable - dummy arguments, denoting an absent argument. - - * Non-pointer variables with 'TARGET' attribute can be used as actual - argument to 'POINTER' dummies with 'INTENT(IN)'. - - * Pointers including procedure pointers and those in a derived type - (pointer components) can now be initialized by a target instead of - only by 'NULL'. - - * The 'EXIT' statement (with construct-name) can be now be used to - leave not only the 'DO' but also the 'ASSOCIATE', 'BLOCK', 'IF', - 'SELECT CASE' and 'SELECT TYPE' constructs. - - * Internal procedures can now be used as actual argument. - - * Minor features: obsolesce diagnostics for 'ENTRY' with - '-std=f2008'; a line may start with a semicolon; for internal and - module procedures 'END' can be used instead of 'END SUBROUTINE' and - 'END FUNCTION'; 'SELECTED_REAL_KIND' now also takes a 'RADIX' - argument; intrinsic types are supported for - 'TYPE'(INTRINSIC-TYPE-SPEC); multiple type-bound procedures can be - declared in a single 'PROCEDURE' statement; implied-shape arrays - are supported for named constants ('PARAMETER'). - - -File: gfortran.info, Node: TS 29113 status, Prev: Fortran 2008 status, Up: Fortran 2003 and 2008 status - -4.3 Technical Specification 29113 Status -======================================== - -GNU Fortran supports some of the new features of the Technical -Specification (TS) 29113 on Further Interoperability of Fortran with C. -The wiki (http://gcc.gnu.org/wiki/TS29113Status) has some information -about the current TS 29113 implementation status. In particular, the -following is implemented. - - See also *note Further Interoperability of Fortran with C::. - - * The '-std=f2008ts' option. - - * The 'OPTIONAL' attribute is allowed for dummy arguments of 'BIND(C) - procedures.' - - * The 'RANK' intrinsic is supported. - - * GNU Fortran's implementation for variables with 'ASYNCHRONOUS' - attribute is compatible with TS 29113. - - * Assumed types ('TYPE(*)'. - - * Assumed-rank ('DIMENSION(..)'). However, the array descriptor of - the TS is not yet supported. - - -File: gfortran.info, Node: Compiler Characteristics, Next: Extensions, Prev: Fortran 2003 and 2008 status, Up: Top - -5 Compiler Characteristics -************************** - -This chapter describes certain characteristics of the GNU Fortran -compiler, that are not specified by the Fortran standard, but which -might in some way or another become visible to the programmer. - -* Menu: - -* KIND Type Parameters:: -* Internal representation of LOGICAL variables:: -* Thread-safety of the runtime library:: -* Data consistency and durability:: - - -File: gfortran.info, Node: KIND Type Parameters, Next: Internal representation of LOGICAL variables, Up: Compiler Characteristics - -5.1 KIND Type Parameters -======================== - -The 'KIND' type parameters supported by GNU Fortran for the primitive -data types are: - -'INTEGER' - 1, 2, 4, 8*, 16*, default: 4** - -'LOGICAL' - 1, 2, 4, 8*, 16*, default: 4** - -'REAL' - 4, 8, 10*, 16*, default: 4*** - -'COMPLEX' - 4, 8, 10*, 16*, default: 4*** - -'DOUBLE PRECISION' - 4, 8, 10*, 16*, default: 8*** - -'CHARACTER' - 1, 4, default: 1 - -* not available on all systems -** unless '-fdefault-integer-8' is used -*** unless '-fdefault-real-8' is used (see *note Fortran Dialect -Options::) - -The 'KIND' value matches the storage size in bytes, except for 'COMPLEX' -where the storage size is twice as much (or both real and imaginary part -are a real value of the given size). It is recommended to use the *note -SELECTED_CHAR_KIND::, *note SELECTED_INT_KIND:: and *note -SELECTED_REAL_KIND:: intrinsics or the 'INT8', 'INT16', 'INT32', -'INT64', 'REAL32', 'REAL64', and 'REAL128' parameters of the -'ISO_FORTRAN_ENV' module instead of the concrete values. The available -kind parameters can be found in the constant arrays 'CHARACTER_KINDS', -'INTEGER_KINDS', 'LOGICAL_KINDS' and 'REAL_KINDS' in the *note -ISO_FORTRAN_ENV:: module. For C interoperability, the kind parameters -of the *note ISO_C_BINDING:: module should be used. - - -File: gfortran.info, Node: Internal representation of LOGICAL variables, Next: Thread-safety of the runtime library, Prev: KIND Type Parameters, Up: Compiler Characteristics - -5.2 Internal representation of LOGICAL variables -================================================ - -The Fortran standard does not specify how variables of 'LOGICAL' type -are represented, beyond requiring that 'LOGICAL' variables of default -kind have the same storage size as default 'INTEGER' and 'REAL' -variables. The GNU Fortran internal representation is as follows. - - A 'LOGICAL(KIND=N)' variable is represented as an 'INTEGER(KIND=N)' -variable, however, with only two permissible values: '1' for '.TRUE.' -and '0' for '.FALSE.'. Any other integer value results in undefined -behavior. - - See also *note Argument passing conventions:: and *note -Interoperability with C::. - - -File: gfortran.info, Node: Thread-safety of the runtime library, Next: Data consistency and durability, Prev: Internal representation of LOGICAL variables, Up: Compiler Characteristics - -5.3 Thread-safety of the runtime library -======================================== - -GNU Fortran can be used in programs with multiple threads, e.g. by using -OpenMP, by calling OS thread handling functions via the 'ISO_C_BINDING' -facility, or by GNU Fortran compiled library code being called from a -multi-threaded program. - - The GNU Fortran runtime library, ('libgfortran'), supports being -called concurrently from multiple threads with the following exceptions. - - During library initialization, the C 'getenv' function is used, which -need not be thread-safe. Similarly, the 'getenv' function is used to -implement the 'GET_ENVIRONMENT_VARIABLE' and 'GETENV' intrinsics. It is -the responsibility of the user to ensure that the environment is not -being updated concurrently when any of these actions are taking place. - - The 'EXECUTE_COMMAND_LINE' and 'SYSTEM' intrinsics are implemented -with the 'system' function, which need not be thread-safe. It is the -responsibility of the user to ensure that 'system' is not called -concurrently. - - Finally, for platforms not supporting thread-safe POSIX functions, -further functionality might not be thread-safe. For details, please -consult the documentation for your operating system. - - -File: gfortran.info, Node: Data consistency and durability, Prev: Thread-safety of the runtime library, Up: Compiler Characteristics - -5.4 Data consistency and durability -=================================== - -This section contains a brief overview of data and metadata consistency -and durability issues when doing I/O. - - With respect to durability, GNU Fortran makes no effort to ensure -that data is committed to stable storage. If this is required, the GNU -Fortran programmer can use the intrinsic 'FNUM' to retrieve the low -level file descriptor corresponding to an open Fortran unit. Then, -using e.g. the 'ISO_C_BINDING' feature, one can call the underlying -system call to flush dirty data to stable storage, such as 'fsync' on -POSIX, '_commit' on MingW, or 'fcntl(fd, F_FULLSYNC, 0)' on Mac OS X. -The following example shows how to call fsync: - - ! Declare the interface for POSIX fsync function - interface - function fsync (fd) bind(c,name="fsync") - use iso_c_binding, only: c_int - integer(c_int), value :: fd - integer(c_int) :: fsync - end function fsync - end interface - - ! Variable declaration - integer :: ret - - ! Opening unit 10 - open (10,file="foo") - - ! ... - ! Perform I/O on unit 10 - ! ... - - ! Flush and sync - flush(10) - ret = fsync(fnum(10)) - - ! Handle possible error - if (ret /= 0) stop "Error calling FSYNC" - - With respect to consistency, for regular files GNU Fortran uses -buffered I/O in order to improve performance. This buffer is flushed -automatically when full and in some other situations, e.g. when closing -a unit. It can also be explicitly flushed with the 'FLUSH' statement. -Also, the buffering can be turned off with the 'GFORTRAN_UNBUFFERED_ALL' -and 'GFORTRAN_UNBUFFERED_PRECONNECTED' environment variables. Special -files, such as terminals and pipes, are always unbuffered. Sometimes, -however, further things may need to be done in order to allow other -processes to see data that GNU Fortran has written, as follows. - - The Windows platform supports a relaxed metadata consistency model, -where file metadata is written to the directory lazily. This means -that, for instance, the 'dir' command can show a stale size for a file. -One can force a directory metadata update by closing the unit, or by -calling '_commit' on the file descriptor. Note, though, that '_commit' -will force all dirty data to stable storage, which is often a very slow -operation. - - The Network File System (NFS) implements a relaxed consistency model -called open-to-close consistency. Closing a file forces dirty data and -metadata to be flushed to the server, and opening a file forces the -client to contact the server in order to revalidate cached data. -'fsync' will also force a flush of dirty data and metadata to the -server. Similar to 'open' and 'close', acquiring and releasing 'fcntl' -file locks, if the server supports them, will also force cache -validation and flushing dirty data and metadata. - - -File: gfortran.info, Node: Extensions, Next: Mixed-Language Programming, Prev: Compiler Characteristics, Up: Top - -6 Extensions -************ - -The two sections below detail the extensions to standard Fortran that -are implemented in GNU Fortran, as well as some of the popular or -historically important extensions that are not (or not yet) implemented. -For the latter case, we explain the alternatives available to GNU -Fortran users, including replacement by standard-conforming code or GNU -extensions. - -* Menu: - -* Extensions implemented in GNU Fortran:: -* Extensions not implemented in GNU Fortran:: - - -File: gfortran.info, Node: Extensions implemented in GNU Fortran, Next: Extensions not implemented in GNU Fortran, Up: Extensions - -6.1 Extensions implemented in GNU Fortran -========================================= - -GNU Fortran implements a number of extensions over standard Fortran. -This chapter contains information on their syntax and meaning. There -are currently two categories of GNU Fortran extensions, those that -provide functionality beyond that provided by any standard, and those -that are supported by GNU Fortran purely for backward compatibility with -legacy compilers. By default, '-std=gnu' allows the compiler to accept -both types of extensions, but to warn about the use of the latter. -Specifying either '-std=f95', '-std=f2003' or '-std=f2008' disables both -types of extensions, and '-std=legacy' allows both without warning. - -* Menu: - -* Old-style kind specifications:: -* Old-style variable initialization:: -* Extensions to namelist:: -* X format descriptor without count field:: -* Commas in FORMAT specifications:: -* Missing period in FORMAT specifications:: -* I/O item lists:: -* 'Q' exponent-letter:: -* BOZ literal constants:: -* Real array indices:: -* Unary operators:: -* Implicitly convert LOGICAL and INTEGER values:: -* Hollerith constants support:: -* Cray pointers:: -* CONVERT specifier:: -* OpenMP:: -* Argument list functions:: - - -File: gfortran.info, Node: Old-style kind specifications, Next: Old-style variable initialization, Up: Extensions implemented in GNU Fortran - -6.1.1 Old-style kind specifications ------------------------------------ - -GNU Fortran allows old-style kind specifications in declarations. These -look like: - TYPESPEC*size x,y,z -where 'TYPESPEC' is a basic type ('INTEGER', 'REAL', etc.), and where -'size' is a byte count corresponding to the storage size of a valid kind -for that type. (For 'COMPLEX' variables, 'size' is the total size of -the real and imaginary parts.) The statement then declares 'x', 'y' and -'z' to be of type 'TYPESPEC' with the appropriate kind. This is -equivalent to the standard-conforming declaration - TYPESPEC(k) x,y,z -where 'k' is the kind parameter suitable for the intended precision. As -kind parameters are implementation-dependent, use the 'KIND', -'SELECTED_INT_KIND' and 'SELECTED_REAL_KIND' intrinsics to retrieve the -correct value, for instance 'REAL*8 x' can be replaced by: - INTEGER, PARAMETER :: dbl = KIND(1.0d0) - REAL(KIND=dbl) :: x - - -File: gfortran.info, Node: Old-style variable initialization, Next: Extensions to namelist, Prev: Old-style kind specifications, Up: Extensions implemented in GNU Fortran - -6.1.2 Old-style variable initialization ---------------------------------------- - -GNU Fortran allows old-style initialization of variables of the form: - INTEGER i/1/,j/2/ - REAL x(2,2) /3*0.,1./ - The syntax for the initializers is as for the 'DATA' statement, but -unlike in a 'DATA' statement, an initializer only applies to the -variable immediately preceding the initialization. In other words, -something like 'INTEGER I,J/2,3/' is not valid. This style of -initialization is only allowed in declarations without double colons -('::'); the double colons were introduced in Fortran 90, which also -introduced a standard syntax for initializing variables in type -declarations. - - Examples of standard-conforming code equivalent to the above example -are: - ! Fortran 90 - INTEGER :: i = 1, j = 2 - REAL :: x(2,2) = RESHAPE((/0.,0.,0.,1./),SHAPE(x)) - ! Fortran 77 - INTEGER i, j - REAL x(2,2) - DATA i/1/, j/2/, x/3*0.,1./ - - Note that variables which are explicitly initialized in declarations -or in 'DATA' statements automatically acquire the 'SAVE' attribute. - - -File: gfortran.info, Node: Extensions to namelist, Next: X format descriptor without count field, Prev: Old-style variable initialization, Up: Extensions implemented in GNU Fortran - -6.1.3 Extensions to namelist ----------------------------- - -GNU Fortran fully supports the Fortran 95 standard for namelist I/O -including array qualifiers, substrings and fully qualified derived -types. The output from a namelist write is compatible with namelist -read. The output has all names in upper case and indentation to column -1 after the namelist name. Two extensions are permitted: - - Old-style use of '$' instead of '&' - $MYNML - X(:)%Y(2) = 1.0 2.0 3.0 - CH(1:4) = "abcd" - $END - - It should be noted that the default terminator is '/' rather than -'&END'. - - Querying of the namelist when inputting from stdin. After at least -one space, entering '?' sends to stdout the namelist name and the names -of the variables in the namelist: - ? - - &mynml - x - x%y - ch - &end - - Entering '=?' outputs the namelist to stdout, as if 'WRITE(*,NML = -mynml)' had been called: - =? - - &MYNML - X(1)%Y= 0.000000 , 1.000000 , 0.000000 , - X(2)%Y= 0.000000 , 2.000000 , 0.000000 , - X(3)%Y= 0.000000 , 3.000000 , 0.000000 , - CH=abcd, / - - To aid this dialog, when input is from stdin, errors send their -messages to stderr and execution continues, even if 'IOSTAT' is set. - - 'PRINT' namelist is permitted. This causes an error if '-std=f95' is -used. - PROGRAM test_print - REAL, dimension (4) :: x = (/1.0, 2.0, 3.0, 4.0/) - NAMELIST /mynml/ x - PRINT mynml - END PROGRAM test_print - - Expanded namelist reads are permitted. This causes an error if -'-std=f95' is used. In the following example, the first element of the -array will be given the value 0.00 and the two succeeding elements will -be given the values 1.00 and 2.00. - &MYNML - X(1,1) = 0.00 , 1.00 , 2.00 - / - - When writing a namelist, if no 'DELIM=' is specified, by default a -double quote is used to delimit character strings. If -std=F95, F2003, -or F2008, etc, the delim status is set to 'none'. Defaulting to quotes -ensures that namelists with character strings can be subsequently read -back in accurately. - - -File: gfortran.info, Node: X format descriptor without count field, Next: Commas in FORMAT specifications, Prev: Extensions to namelist, Up: Extensions implemented in GNU Fortran - -6.1.4 'X' format descriptor without count field ------------------------------------------------ - -To support legacy codes, GNU Fortran permits the count field of the 'X' -edit descriptor in 'FORMAT' statements to be omitted. When omitted, the -count is implicitly assumed to be one. - - PRINT 10, 2, 3 - 10 FORMAT (I1, X, I1) - - -File: gfortran.info, Node: Commas in FORMAT specifications, Next: Missing period in FORMAT specifications, Prev: X format descriptor without count field, Up: Extensions implemented in GNU Fortran - -6.1.5 Commas in 'FORMAT' specifications ---------------------------------------- - -To support legacy codes, GNU Fortran allows the comma separator to be -omitted immediately before and after character string edit descriptors -in 'FORMAT' statements. - - PRINT 10, 2, 3 - 10 FORMAT ('FOO='I1' BAR='I2) - - -File: gfortran.info, Node: Missing period in FORMAT specifications, Next: I/O item lists, Prev: Commas in FORMAT specifications, Up: Extensions implemented in GNU Fortran - -6.1.6 Missing period in 'FORMAT' specifications ------------------------------------------------ - -To support legacy codes, GNU Fortran allows missing periods in format -specifications if and only if '-std=legacy' is given on the command -line. This is considered non-conforming code and is discouraged. - - REAL :: value - READ(*,10) value - 10 FORMAT ('F4') - - -File: gfortran.info, Node: I/O item lists, Next: 'Q' exponent-letter, Prev: Missing period in FORMAT specifications, Up: Extensions implemented in GNU Fortran - -6.1.7 I/O item lists --------------------- - -To support legacy codes, GNU Fortran allows the input item list of the -'READ' statement, and the output item lists of the 'WRITE' and 'PRINT' -statements, to start with a comma. - - -File: gfortran.info, Node: 'Q' exponent-letter, Next: BOZ literal constants, Prev: I/O item lists, Up: Extensions implemented in GNU Fortran - -6.1.8 'Q' exponent-letter -------------------------- - -GNU Fortran accepts real literal constants with an exponent-letter of -'Q', for example, '1.23Q45'. The constant is interpreted as a -'REAL(16)' entity on targets that support this type. If the target does -not support 'REAL(16)' but has a 'REAL(10)' type, then the -real-literal-constant will be interpreted as a 'REAL(10)' entity. In -the absence of 'REAL(16)' and 'REAL(10)', an error will occur. - - -File: gfortran.info, Node: BOZ literal constants, Next: Real array indices, Prev: 'Q' exponent-letter, Up: Extensions implemented in GNU Fortran - -6.1.9 BOZ literal constants ---------------------------- - -Besides decimal constants, Fortran also supports binary ('b'), octal -('o') and hexadecimal ('z') integer constants. The syntax is: 'prefix -quote digits quote', were the prefix is either 'b', 'o' or 'z', quote is -either ''' or '"' and the digits are for binary '0' or '1', for octal -between '0' and '7', and for hexadecimal between '0' and 'F'. (Example: -'b'01011101''.) - - Up to Fortran 95, BOZ literals were only allowed to initialize -integer variables in DATA statements. Since Fortran 2003 BOZ literals -are also allowed as argument of 'REAL', 'DBLE', 'INT' and 'CMPLX'; the -result is the same as if the integer BOZ literal had been converted by -'TRANSFER' to, respectively, 'real', 'double precision', 'integer' or -'complex'. As GNU Fortran extension the intrinsic procedures 'FLOAT', -'DFLOAT', 'COMPLEX' and 'DCMPLX' are treated alike. - - As an extension, GNU Fortran allows hexadecimal BOZ literal constants -to be specified using the 'X' prefix, in addition to the standard 'Z' -prefix. The BOZ literal can also be specified by adding a suffix to the -string, for example, 'Z'ABC'' and ''ABC'Z' are equivalent. - - Furthermore, GNU Fortran allows using BOZ literal constants outside -DATA statements and the four intrinsic functions allowed by Fortran -2003. In DATA statements, in direct assignments, where the right-hand -side only contains a BOZ literal constant, and for old-style -initializers of the form 'integer i /o'0173'/', the constant is -transferred as if 'TRANSFER' had been used; for 'COMPLEX' numbers, only -the real part is initialized unless 'CMPLX' is used. In all other -cases, the BOZ literal constant is converted to an 'INTEGER' value with -the largest decimal representation. This value is then converted -numerically to the type and kind of the variable in question. (For -instance, 'real :: r = b'0000001' + 1' initializes 'r' with '2.0'.) As -different compilers implement the extension differently, one should be -careful when doing bitwise initialization of non-integer variables. - - Note that initializing an 'INTEGER' variable with a statement such as -'DATA i/Z'FFFFFFFF'/' will give an integer overflow error rather than -the desired result of -1 when 'i' is a 32-bit integer on a system that -supports 64-bit integers. The '-fno-range-check' option can be used as -a workaround for legacy code that initializes integers in this manner. - - -File: gfortran.info, Node: Real array indices, Next: Unary operators, Prev: BOZ literal constants, Up: Extensions implemented in GNU Fortran - -6.1.10 Real array indices -------------------------- - -As an extension, GNU Fortran allows the use of 'REAL' expressions or -variables as array indices. - - -File: gfortran.info, Node: Unary operators, Next: Implicitly convert LOGICAL and INTEGER values, Prev: Real array indices, Up: Extensions implemented in GNU Fortran - -6.1.11 Unary operators ----------------------- - -As an extension, GNU Fortran allows unary plus and unary minus operators -to appear as the second operand of binary arithmetic operators without -the need for parenthesis. - - X = Y * -Z - - -File: gfortran.info, Node: Implicitly convert LOGICAL and INTEGER values, Next: Hollerith constants support, Prev: Unary operators, Up: Extensions implemented in GNU Fortran - -6.1.12 Implicitly convert 'LOGICAL' and 'INTEGER' values --------------------------------------------------------- - -As an extension for backwards compatibility with other compilers, GNU -Fortran allows the implicit conversion of 'LOGICAL' values to 'INTEGER' -values and vice versa. When converting from a 'LOGICAL' to an -'INTEGER', '.FALSE.' is interpreted as zero, and '.TRUE.' is interpreted -as one. When converting from 'INTEGER' to 'LOGICAL', the value zero is -interpreted as '.FALSE.' and any nonzero value is interpreted as -'.TRUE.'. - - LOGICAL :: l - l = 1 - INTEGER :: i - i = .TRUE. - - However, there is no implicit conversion of 'INTEGER' values in -'if'-statements, nor of 'LOGICAL' or 'INTEGER' values in I/O operations. - - -File: gfortran.info, Node: Hollerith constants support, Next: Cray pointers, Prev: Implicitly convert LOGICAL and INTEGER values, Up: Extensions implemented in GNU Fortran - -6.1.13 Hollerith constants support ----------------------------------- - -GNU Fortran supports Hollerith constants in assignments, function -arguments, and 'DATA' and 'ASSIGN' statements. A Hollerith constant is -written as a string of characters preceded by an integer constant -indicating the character count, and the letter 'H' or 'h', and stored in -bytewise fashion in a numeric ('INTEGER', 'REAL', or 'complex') or -'LOGICAL' variable. The constant will be padded or truncated to fit the -size of the variable in which it is stored. - - Examples of valid uses of Hollerith constants: - complex*16 x(2) - data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/ - x(1) = 16HABCDEFGHIJKLMNOP - call foo (4h abc) - - Invalid Hollerith constants examples: - integer*4 a - a = 8H12345678 ! Valid, but the Hollerith constant will be truncated. - a = 0H ! At least one character is needed. - - In general, Hollerith constants were used to provide a rudimentary -facility for handling character strings in early Fortran compilers, -prior to the introduction of 'CHARACTER' variables in Fortran 77; in -those cases, the standard-compliant equivalent is to convert the program -to use proper character strings. On occasion, there may be a case where -the intent is specifically to initialize a numeric variable with a given -byte sequence. In these cases, the same result can be obtained by using -the 'TRANSFER' statement, as in this example. - INTEGER(KIND=4) :: a - a = TRANSFER ("abcd", a) ! equivalent to: a = 4Habcd - - -File: gfortran.info, Node: Cray pointers, Next: CONVERT specifier, Prev: Hollerith constants support, Up: Extensions implemented in GNU Fortran - -6.1.14 Cray pointers --------------------- - -Cray pointers are part of a non-standard extension that provides a -C-like pointer in Fortran. This is accomplished through a pair of -variables: an integer "pointer" that holds a memory address, and a -"pointee" that is used to dereference the pointer. - - Pointer/pointee pairs are declared in statements of the form: - pointer ( <pointer> , <pointee> ) - or, - pointer ( <pointer1> , <pointee1> ), ( <pointer2> , <pointee2> ), ... - The pointer is an integer that is intended to hold a memory address. -The pointee may be an array or scalar. A pointee can be an assumed size -array--that is, the last dimension may be left unspecified by using a -'*' in place of a value--but a pointee cannot be an assumed shape array. -No space is allocated for the pointee. - - The pointee may have its type declared before or after the pointer -statement, and its array specification (if any) may be declared before, -during, or after the pointer statement. The pointer may be declared as -an integer prior to the pointer statement. However, some machines have -default integer sizes that are different than the size of a pointer, and -so the following code is not portable: - integer ipt - pointer (ipt, iarr) - If a pointer is declared with a kind that is too small, the compiler -will issue a warning; the resulting binary will probably not work -correctly, because the memory addresses stored in the pointers may be -truncated. It is safer to omit the first line of the above example; if -explicit declaration of ipt's type is omitted, then the compiler will -ensure that ipt is an integer variable large enough to hold a pointer. - - Pointer arithmetic is valid with Cray pointers, but it is not the -same as C pointer arithmetic. Cray pointers are just ordinary integers, -so the user is responsible for determining how many bytes to add to a -pointer in order to increment it. Consider the following example: - real target(10) - real pointee(10) - pointer (ipt, pointee) - ipt = loc (target) - ipt = ipt + 1 - The last statement does not set 'ipt' to the address of 'target(1)', -as it would in C pointer arithmetic. Adding '1' to 'ipt' just adds one -byte to the address stored in 'ipt'. - - Any expression involving the pointee will be translated to use the -value stored in the pointer as the base address. - - To get the address of elements, this extension provides an intrinsic -function 'LOC()'. The 'LOC()' function is equivalent to the '&' -operator in C, except the address is cast to an integer type: - real ar(10) - pointer(ipt, arpte(10)) - real arpte - ipt = loc(ar) ! Makes arpte is an alias for ar - arpte(1) = 1.0 ! Sets ar(1) to 1.0 - The pointer can also be set by a call to the 'MALLOC' intrinsic (see -*note MALLOC::). - - Cray pointees often are used to alias an existing variable. For -example: - integer target(10) - integer iarr(10) - pointer (ipt, iarr) - ipt = loc(target) - As long as 'ipt' remains unchanged, 'iarr' is now an alias for -'target'. The optimizer, however, will not detect this aliasing, so it -is unsafe to use 'iarr' and 'target' simultaneously. Using a pointee in -any way that violates the Fortran aliasing rules or assumptions is -illegal. It is the user's responsibility to avoid doing this; the -compiler works under the assumption that no such aliasing occurs. - - Cray pointers will work correctly when there is no aliasing (i.e., -when they are used to access a dynamically allocated block of memory), -and also in any routine where a pointee is used, but any variable with -which it shares storage is not used. Code that violates these rules may -not run as the user intends. This is not a bug in the optimizer; any -code that violates the aliasing rules is illegal. (Note that this is -not unique to GNU Fortran; any Fortran compiler that supports Cray -pointers will "incorrectly" optimize code with illegal aliasing.) - - There are a number of restrictions on the attributes that can be -applied to Cray pointers and pointees. Pointees may not have the -'ALLOCATABLE', 'INTENT', 'OPTIONAL', 'DUMMY', 'TARGET', 'INTRINSIC', or -'POINTER' attributes. Pointers may not have the 'DIMENSION', 'POINTER', -'TARGET', 'ALLOCATABLE', 'EXTERNAL', or 'INTRINSIC' attributes, nor may -they be function results. Pointees may not occur in more than one -pointer statement. A pointee cannot be a pointer. Pointees cannot -occur in equivalence, common, or data statements. - - A Cray pointer may also point to a function or a subroutine. For -example, the following excerpt is valid: - implicit none - external sub - pointer (subptr,subpte) - external subpte - subptr = loc(sub) - call subpte() - [...] - subroutine sub - [...] - end subroutine sub - - A pointer may be modified during the course of a program, and this -will change the location to which the pointee refers. However, when -pointees are passed as arguments, they are treated as ordinary variables -in the invoked function. Subsequent changes to the pointer will not -change the base address of the array that was passed. - - -File: gfortran.info, Node: CONVERT specifier, Next: OpenMP, Prev: Cray pointers, Up: Extensions implemented in GNU Fortran - -6.1.15 'CONVERT' specifier --------------------------- - -GNU Fortran allows the conversion of unformatted data between little- -and big-endian representation to facilitate moving of data between -different systems. The conversion can be indicated with the 'CONVERT' -specifier on the 'OPEN' statement. *Note GFORTRAN_CONVERT_UNIT::, for -an alternative way of specifying the data format via an environment -variable. - - Valid values for 'CONVERT' are: - 'CONVERT='NATIVE'' Use the native format. This is the default. - 'CONVERT='SWAP'' Swap between little- and big-endian. - 'CONVERT='LITTLE_ENDIAN'' Use the little-endian representation for - unformatted files. - 'CONVERT='BIG_ENDIAN'' Use the big-endian representation for - unformatted files. - - Using the option could look like this: - open(file='big.dat',form='unformatted',access='sequential', & - convert='big_endian') - - The value of the conversion can be queried by using -'INQUIRE(CONVERT=ch)'. The values returned are ''BIG_ENDIAN'' and -''LITTLE_ENDIAN''. - - 'CONVERT' works between big- and little-endian for 'INTEGER' values -of all supported kinds and for 'REAL' on IEEE systems of kinds 4 and 8. -Conversion between different "extended double" types on different -architectures such as m68k and x86_64, which GNU Fortran supports as -'REAL(KIND=10)' and 'REAL(KIND=16)', will probably not work. - - _Note that the values specified via the GFORTRAN_CONVERT_UNIT -environment variable will override the CONVERT specifier in the open -statement_. This is to give control over data formats to users who do -not have the source code of their program available. - - Using anything but the native representation for unformatted data -carries a significant speed overhead. If speed in this area matters to -you, it is best if you use this only for data that needs to be portable. - - -File: gfortran.info, Node: OpenMP, Next: Argument list functions, Prev: CONVERT specifier, Up: Extensions implemented in GNU Fortran - -6.1.16 OpenMP -------------- - -OpenMP (Open Multi-Processing) is an application programming interface -(API) that supports multi-platform shared memory multiprocessing -programming in C/C++ and Fortran on many architectures, including Unix -and Microsoft Windows platforms. It consists of a set of compiler -directives, library routines, and environment variables that influence -run-time behavior. - - GNU Fortran strives to be compatible to the OpenMP Application -Program Interface v3.1 (http://www.openmp.org/mp-documents/spec31.pdf). - - To enable the processing of the OpenMP directive '!$omp' in free-form -source code; the 'c$omp', '*$omp' and '!$omp' directives in fixed form; -the '!$' conditional compilation sentinels in free form; and the 'c$', -'*$' and '!$' sentinels in fixed form, 'gfortran' needs to be invoked -with the '-fopenmp'. This also arranges for automatic linking of the -GNU OpenMP runtime library *note libgomp: (libgomp)Top. - - The OpenMP Fortran runtime library routines are provided both in a -form of a Fortran 90 module named 'omp_lib' and in a form of a Fortran -'include' file named 'omp_lib.h'. - - An example of a parallelized loop taken from Appendix A.1 of the -OpenMP Application Program Interface v2.5: - SUBROUTINE A1(N, A, B) - INTEGER I, N - REAL B(N), A(N) - !$OMP PARALLEL DO !I is private by default - DO I=2,N - B(I) = (A(I) + A(I-1)) / 2.0 - ENDDO - !$OMP END PARALLEL DO - END SUBROUTINE A1 - - Please note: - * '-fopenmp' implies '-frecursive', i.e., all local arrays will be - allocated on the stack. When porting existing code to OpenMP, this - may lead to surprising results, especially to segmentation faults - if the stacksize is limited. - - * On glibc-based systems, OpenMP enabled applications cannot be - statically linked due to limitations of the underlying - pthreads-implementation. It might be possible to get a working - solution if '-Wl,--whole-archive -lpthread -Wl,--no-whole-archive' - is added to the command line. However, this is not supported by - 'gcc' and thus not recommended. - - -File: gfortran.info, Node: Argument list functions, Prev: OpenMP, Up: Extensions implemented in GNU Fortran - -6.1.17 Argument list functions '%VAL', '%REF' and '%LOC' --------------------------------------------------------- - -GNU Fortran supports argument list functions '%VAL', '%REF' and '%LOC' -statements, for backward compatibility with g77. It is recommended that -these should be used only for code that is accessing facilities outside -of GNU Fortran, such as operating system or windowing facilities. It is -best to constrain such uses to isolated portions of a program-portions -that deal specifically and exclusively with low-level, system-dependent -facilities. Such portions might well provide a portable interface for -use by the program as a whole, but are themselves not portable, and -should be thoroughly tested each time they are rebuilt using a new -compiler or version of a compiler. - - '%VAL' passes a scalar argument by value, '%REF' passes it by -reference and '%LOC' passes its memory location. Since gfortran already -passes scalar arguments by reference, '%REF' is in effect a do-nothing. -'%LOC' has the same effect as a Fortran pointer. - - An example of passing an argument by value to a C subroutine foo.: - C - C prototype void foo_ (float x); - C - external foo - real*4 x - x = 3.14159 - call foo (%VAL (x)) - end - - For details refer to the g77 manual -<http://gcc.gnu.org/onlinedocs/gcc-3.4.6/g77/index.html#Top>. - - Also, 'c_by_val.f' and its partner 'c_by_val.c' of the GNU Fortran -testsuite are worth a look. - - -File: gfortran.info, Node: Extensions not implemented in GNU Fortran, Prev: Extensions implemented in GNU Fortran, Up: Extensions - -6.2 Extensions not implemented in GNU Fortran -============================================= - -The long history of the Fortran language, its wide use and broad -userbase, the large number of different compiler vendors and the lack of -some features crucial to users in the first standards have lead to the -existence of a number of important extensions to the language. While -some of the most useful or popular extensions are supported by the GNU -Fortran compiler, not all existing extensions are supported. This -section aims at listing these extensions and offering advice on how best -make code that uses them running with the GNU Fortran compiler. - -* Menu: - -* STRUCTURE and RECORD:: -* ENCODE and DECODE statements:: -* Variable FORMAT expressions:: -* Alternate complex function syntax:: -* Volatile COMMON blocks:: - - -File: gfortran.info, Node: STRUCTURE and RECORD, Next: ENCODE and DECODE statements, Up: Extensions not implemented in GNU Fortran - -6.2.1 'STRUCTURE' and 'RECORD' ------------------------------- - -Record structures are a pre-Fortran-90 vendor extension to create -user-defined aggregate data types. GNU Fortran does not support record -structures, only Fortran 90's "derived types", which have a different -syntax. - - In many cases, record structures can easily be converted to derived -types. To convert, replace 'STRUCTURE /'STRUCTURE-NAME'/' by 'TYPE' -TYPE-NAME. Additionally, replace 'RECORD /'STRUCTURE-NAME'/' by -'TYPE('TYPE-NAME')'. Finally, in the component access, replace the -period ('.') by the percent sign ('%'). - - Here is an example of code using the non portable record structure -syntax: - - ! Declaring a structure named ``item'' and containing three fields: - ! an integer ID, an description string and a floating-point price. - STRUCTURE /item/ - INTEGER id - CHARACTER(LEN=200) description - REAL price - END STRUCTURE - - ! Define two variables, an single record of type ``item'' - ! named ``pear'', and an array of items named ``store_catalog'' - RECORD /item/ pear, store_catalog(100) - - ! We can directly access the fields of both variables - pear.id = 92316 - pear.description = "juicy D'Anjou pear" - pear.price = 0.15 - store_catalog(7).id = 7831 - store_catalog(7).description = "milk bottle" - store_catalog(7).price = 1.2 - - ! We can also manipulate the whole structure - store_catalog(12) = pear - print *, store_catalog(12) - -This code can easily be rewritten in the Fortran 90 syntax as following: - - ! ``STRUCTURE /name/ ... END STRUCTURE'' becomes - ! ``TYPE name ... END TYPE'' - TYPE item - INTEGER id - CHARACTER(LEN=200) description - REAL price - END TYPE - - ! ``RECORD /name/ variable'' becomes ``TYPE(name) variable'' - TYPE(item) pear, store_catalog(100) - - ! Instead of using a dot (.) to access fields of a record, the - ! standard syntax uses a percent sign (%) - pear%id = 92316 - pear%description = "juicy D'Anjou pear" - pear%price = 0.15 - store_catalog(7)%id = 7831 - store_catalog(7)%description = "milk bottle" - store_catalog(7)%price = 1.2 - - ! Assignments of a whole variable do not change - store_catalog(12) = pear - print *, store_catalog(12) - - -File: gfortran.info, Node: ENCODE and DECODE statements, Next: Variable FORMAT expressions, Prev: STRUCTURE and RECORD, Up: Extensions not implemented in GNU Fortran - -6.2.2 'ENCODE' and 'DECODE' statements --------------------------------------- - -GNU Fortran does not support the 'ENCODE' and 'DECODE' statements. -These statements are best replaced by 'READ' and 'WRITE' statements -involving internal files ('CHARACTER' variables and arrays), which have -been part of the Fortran standard since Fortran 77. For example, -replace a code fragment like - - INTEGER*1 LINE(80) - REAL A, B, C - c ... Code that sets LINE - DECODE (80, 9000, LINE) A, B, C - 9000 FORMAT (1X, 3(F10.5)) - -with the following: - - CHARACTER(LEN=80) LINE - REAL A, B, C - c ... Code that sets LINE - READ (UNIT=LINE, FMT=9000) A, B, C - 9000 FORMAT (1X, 3(F10.5)) - - Similarly, replace a code fragment like - - INTEGER*1 LINE(80) - REAL A, B, C - c ... Code that sets A, B and C - ENCODE (80, 9000, LINE) A, B, C - 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5)) - -with the following: - - CHARACTER(LEN=80) LINE - REAL A, B, C - c ... Code that sets A, B and C - WRITE (UNIT=LINE, FMT=9000) A, B, C - 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5)) - - -File: gfortran.info, Node: Variable FORMAT expressions, Next: Alternate complex function syntax, Prev: ENCODE and DECODE statements, Up: Extensions not implemented in GNU Fortran - -6.2.3 Variable 'FORMAT' expressions ------------------------------------ - -A variable 'FORMAT' expression is format statement which includes angle -brackets enclosing a Fortran expression: 'FORMAT(I<N>)'. GNU Fortran -does not support this legacy extension. The effect of variable format -expressions can be reproduced by using the more powerful (and standard) -combination of internal output and string formats. For example, replace -a code fragment like this: - - WRITE(6,20) INT1 - 20 FORMAT(I<N+1>) - -with the following: - - c Variable declaration - CHARACTER(LEN=20) FMT - c - c Other code here... - c - WRITE(FMT,'("(I", I0, ")")') N+1 - WRITE(6,FMT) INT1 - -or with: - - c Variable declaration - CHARACTER(LEN=20) FMT - c - c Other code here... - c - WRITE(FMT,*) N+1 - WRITE(6,"(I" // ADJUSTL(FMT) // ")") INT1 - - -File: gfortran.info, Node: Alternate complex function syntax, Next: Volatile COMMON blocks, Prev: Variable FORMAT expressions, Up: Extensions not implemented in GNU Fortran - -6.2.4 Alternate complex function syntax ---------------------------------------- - -Some Fortran compilers, including 'g77', let the user declare complex -functions with the syntax 'COMPLEX FUNCTION name*16()', as well as -'COMPLEX*16 FUNCTION name()'. Both are non-standard, legacy extensions. -'gfortran' accepts the latter form, which is more common, but not the -former. - - -File: gfortran.info, Node: Volatile COMMON blocks, Prev: Alternate complex function syntax, Up: Extensions not implemented in GNU Fortran - -6.2.5 Volatile 'COMMON' blocks ------------------------------- - -Some Fortran compilers, including 'g77', let the user declare 'COMMON' -with the 'VOLATILE' attribute. This is invalid standard Fortran syntax -and is not supported by 'gfortran'. Note that 'gfortran' accepts -'VOLATILE' variables in 'COMMON' blocks since revision 4.3. - - -File: gfortran.info, Node: Mixed-Language Programming, Next: Intrinsic Procedures, Prev: Extensions, Up: Top - -7 Mixed-Language Programming -**************************** - -* Menu: - -* Interoperability with C:: -* GNU Fortran Compiler Directives:: -* Non-Fortran Main Program:: -* Naming and argument-passing conventions:: - -This chapter is about mixed-language interoperability, but also applies -if one links Fortran code compiled by different compilers. In most -cases, use of the C Binding features of the Fortran 2003 standard is -sufficient, and their use is highly recommended. - - -File: gfortran.info, Node: Interoperability with C, Next: GNU Fortran Compiler Directives, Up: Mixed-Language Programming - -7.1 Interoperability with C -=========================== - -* Menu: - -* Intrinsic Types:: -* Derived Types and struct:: -* Interoperable Global Variables:: -* Interoperable Subroutines and Functions:: -* Working with Pointers:: -* Further Interoperability of Fortran with C:: - -Since Fortran 2003 (ISO/IEC 1539-1:2004(E)) there is a standardized way -to generate procedure and derived-type declarations and global variables -which are interoperable with C (ISO/IEC 9899:1999). The 'bind(C)' -attribute has been added to inform the compiler that a symbol shall be -interoperable with C; also, some constraints are added. Note, however, -that not all C features have a Fortran equivalent or vice versa. For -instance, neither C's unsigned integers nor C's functions with variable -number of arguments have an equivalent in Fortran. - - Note that array dimensions are reversely ordered in C and that arrays -in C always start with index 0 while in Fortran they start by default -with 1. Thus, an array declaration 'A(n,m)' in Fortran matches -'A[m][n]' in C and accessing the element 'A(i,j)' matches 'A[j-1][i-1]'. -The element following 'A(i,j)' (C: 'A[j-1][i-1]'; assuming i < n) in -memory is 'A(i+1,j)' (C: 'A[j-1][i]'). - - -File: gfortran.info, Node: Intrinsic Types, Next: Derived Types and struct, Up: Interoperability with C - -7.1.1 Intrinsic Types ---------------------- - -In order to ensure that exactly the same variable type and kind is used -in C and Fortran, the named constants shall be used which are defined in -the 'ISO_C_BINDING' intrinsic module. That module contains named -constants for kind parameters and character named constants for the -escape sequences in C. For a list of the constants, see *note -ISO_C_BINDING::. - - For logical types, please note that the Fortran standard only -guarantees interoperability between C99's '_Bool' and Fortran's -'C_Bool'-kind logicals and C99 defines that 'true' has the value 1 and -'false' the value 0. Using any other integer value with GNU Fortran's -'LOGICAL' (with any kind parameter) gives an undefined result. (Passing -other integer values than 0 and 1 to GCC's '_Bool' is also undefined, -unless the integer is explicitly or implicitly casted to '_Bool'.) - - -File: gfortran.info, Node: Derived Types and struct, Next: Interoperable Global Variables, Prev: Intrinsic Types, Up: Interoperability with C - -7.1.2 Derived Types and struct ------------------------------- - -For compatibility of derived types with 'struct', one needs to use the -'BIND(C)' attribute in the type declaration. For instance, the -following type declaration - - USE ISO_C_BINDING - TYPE, BIND(C) :: myType - INTEGER(C_INT) :: i1, i2 - INTEGER(C_SIGNED_CHAR) :: i3 - REAL(C_DOUBLE) :: d1 - COMPLEX(C_FLOAT_COMPLEX) :: c1 - CHARACTER(KIND=C_CHAR) :: str(5) - END TYPE - - matches the following 'struct' declaration in C - - struct { - int i1, i2; - /* Note: "char" might be signed or unsigned. */ - signed char i3; - double d1; - float _Complex c1; - char str[5]; - } myType; - - Derived types with the C binding attribute shall not have the -'sequence' attribute, type parameters, the 'extends' attribute, nor -type-bound procedures. Every component must be of interoperable type -and kind and may not have the 'pointer' or 'allocatable' attribute. The -names of the components are irrelevant for interoperability. - - As there exist no direct Fortran equivalents, neither unions nor -structs with bit field or variable-length array members are -interoperable. - - -File: gfortran.info, Node: Interoperable Global Variables, Next: Interoperable Subroutines and Functions, Prev: Derived Types and struct, Up: Interoperability with C - -7.1.3 Interoperable Global Variables ------------------------------------- - -Variables can be made accessible from C using the C binding attribute, -optionally together with specifying a binding name. Those variables -have to be declared in the declaration part of a 'MODULE', be of -interoperable type, and have neither the 'pointer' nor the 'allocatable' -attribute. - - MODULE m - USE myType_module - USE ISO_C_BINDING - integer(C_INT), bind(C, name="_MyProject_flags") :: global_flag - type(myType), bind(C) :: tp - END MODULE - - Here, '_MyProject_flags' is the case-sensitive name of the variable -as seen from C programs while 'global_flag' is the case-insensitive name -as seen from Fortran. If no binding name is specified, as for TP, the C -binding name is the (lowercase) Fortran binding name. If a binding name -is specified, only a single variable may be after the double colon. -Note of warning: You cannot use a global variable to access ERRNO of the -C library as the C standard allows it to be a macro. Use the 'IERRNO' -intrinsic (GNU extension) instead. - - -File: gfortran.info, Node: Interoperable Subroutines and Functions, Next: Working with Pointers, Prev: Interoperable Global Variables, Up: Interoperability with C - -7.1.4 Interoperable Subroutines and Functions ---------------------------------------------- - -Subroutines and functions have to have the 'BIND(C)' attribute to be -compatible with C. The dummy argument declaration is relatively -straightforward. However, one needs to be careful because C uses -call-by-value by default while Fortran behaves usually similar to -call-by-reference. Furthermore, strings and pointers are handled -differently. Note that in Fortran 2003 and 2008 only explicit size and -assumed-size arrays are supported but not assumed-shape or -deferred-shape (i.e. allocatable or pointer) arrays. However, those -are allowed since the Technical Specification 29113, see *note Further -Interoperability of Fortran with C:: - - To pass a variable by value, use the 'VALUE' attribute. Thus, the -following C prototype - - int func(int i, int *j) - - matches the Fortran declaration - - integer(c_int) function func(i,j) - use iso_c_binding, only: c_int - integer(c_int), VALUE :: i - integer(c_int) :: j - - Note that pointer arguments also frequently need the 'VALUE' -attribute, see *note Working with Pointers::. - - Strings are handled quite differently in C and Fortran. In C a -string is a 'NUL'-terminated array of characters while in Fortran each -string has a length associated with it and is thus not terminated (by -e.g. 'NUL'). For example, if one wants to use the following C -function, - - #include <stdio.h> - void print_C(char *string) /* equivalent: char string[] */ - { - printf("%s\n", string); - } - - to print "Hello World" from Fortran, one can call it using - - use iso_c_binding, only: C_CHAR, C_NULL_CHAR - interface - subroutine print_c(string) bind(C, name="print_C") - use iso_c_binding, only: c_char - character(kind=c_char) :: string(*) - end subroutine print_c - end interface - call print_c(C_CHAR_"Hello World"//C_NULL_CHAR) - - As the example shows, one needs to ensure that the string is 'NUL' -terminated. Additionally, the dummy argument STRING of 'print_C' is a -length-one assumed-size array; using 'character(len=*)' is not allowed. -The example above uses 'c_char_"Hello World"' to ensure the string -literal has the right type; typically the default character kind and -'c_char' are the same and thus '"Hello World"' is equivalent. However, -the standard does not guarantee this. - - The use of strings is now further illustrated using the C library -function 'strncpy', whose prototype is - - char *strncpy(char *restrict s1, const char *restrict s2, size_t n); - - The function 'strncpy' copies at most N characters from string S2 to -S1 and returns S1. In the following example, we ignore the return -value: - - use iso_c_binding - implicit none - character(len=30) :: str,str2 - interface - ! Ignore the return value of strncpy -> subroutine - ! "restrict" is always assumed if we do not pass a pointer - subroutine strncpy(dest, src, n) bind(C) - import - character(kind=c_char), intent(out) :: dest(*) - character(kind=c_char), intent(in) :: src(*) - integer(c_size_t), value, intent(in) :: n - end subroutine strncpy - end interface - str = repeat('X',30) ! Initialize whole string with 'X' - call strncpy(str, c_char_"Hello World"//C_NULL_CHAR, & - len(c_char_"Hello World",kind=c_size_t)) - print '(a)', str ! prints: "Hello WorldXXXXXXXXXXXXXXXXXXX" - end - - The intrinsic procedures are described in *note Intrinsic -Procedures::. - - -File: gfortran.info, Node: Working with Pointers, Next: Further Interoperability of Fortran with C, Prev: Interoperable Subroutines and Functions, Up: Interoperability with C - -7.1.5 Working with Pointers ---------------------------- - -C pointers are represented in Fortran via the special opaque derived -type 'type(c_ptr)' (with private components). Thus one needs to use -intrinsic conversion procedures to convert from or to C pointers. - - For some applications, using an assumed type ('TYPE(*)') can be an -alternative to a C pointer; see *note Further Interoperability of -Fortran with C::. - - For example, - - use iso_c_binding - type(c_ptr) :: cptr1, cptr2 - integer, target :: array(7), scalar - integer, pointer :: pa(:), ps - cptr1 = c_loc(array(1)) ! The programmer needs to ensure that the - ! array is contiguous if required by the C - ! procedure - cptr2 = c_loc(scalar) - call c_f_pointer(cptr2, ps) - call c_f_pointer(cptr2, pa, shape=[7]) - - When converting C to Fortran arrays, the one-dimensional 'SHAPE' -argument has to be passed. - - If a pointer is a dummy-argument of an interoperable procedure, it -usually has to be declared using the 'VALUE' attribute. 'void*' matches -'TYPE(C_PTR), VALUE', while 'TYPE(C_PTR)' alone matches 'void**'. - - Procedure pointers are handled analogously to pointers; the C type is -'TYPE(C_FUNPTR)' and the intrinsic conversion procedures are -'C_F_PROCPOINTER' and 'C_FUNLOC'. - - Let us consider two examples of actually passing a procedure pointer -from C to Fortran and vice versa. Note that these examples are also -very similar to passing ordinary pointers between both languages. -First, consider this code in C: - - /* Procedure implemented in Fortran. */ - void get_values (void (*)(double)); - - /* Call-back routine we want called from Fortran. */ - void - print_it (double x) - { - printf ("Number is %f.\n", x); - } - - /* Call Fortran routine and pass call-back to it. */ - void - foobar () - { - get_values (&print_it); - } - - A matching implementation for 'get_values' in Fortran, that correctly -receives the procedure pointer from C and is able to call it, is given -in the following 'MODULE': - - MODULE m - IMPLICIT NONE - - ! Define interface of call-back routine. - ABSTRACT INTERFACE - SUBROUTINE callback (x) - USE, INTRINSIC :: ISO_C_BINDING - REAL(KIND=C_DOUBLE), INTENT(IN), VALUE :: x - END SUBROUTINE callback - END INTERFACE - - CONTAINS - - ! Define C-bound procedure. - SUBROUTINE get_values (cproc) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING - TYPE(C_FUNPTR), INTENT(IN), VALUE :: cproc - - PROCEDURE(callback), POINTER :: proc - - ! Convert C to Fortran procedure pointer. - CALL C_F_PROCPOINTER (cproc, proc) - - ! Call it. - CALL proc (1.0_C_DOUBLE) - CALL proc (-42.0_C_DOUBLE) - CALL proc (18.12_C_DOUBLE) - END SUBROUTINE get_values - - END MODULE m - - Next, we want to call a C routine that expects a procedure pointer -argument and pass it a Fortran procedure (which clearly must be -interoperable!). Again, the C function may be: - - int - call_it (int (*func)(int), int arg) - { - return func (arg); - } - - It can be used as in the following Fortran code: - - MODULE m - USE, INTRINSIC :: ISO_C_BINDING - IMPLICIT NONE - - ! Define interface of C function. - INTERFACE - INTEGER(KIND=C_INT) FUNCTION call_it (func, arg) BIND(C) - USE, INTRINSIC :: ISO_C_BINDING - TYPE(C_FUNPTR), INTENT(IN), VALUE :: func - INTEGER(KIND=C_INT), INTENT(IN), VALUE :: arg - END FUNCTION call_it - END INTERFACE - - CONTAINS - - ! Define procedure passed to C function. - ! It must be interoperable! - INTEGER(KIND=C_INT) FUNCTION double_it (arg) BIND(C) - INTEGER(KIND=C_INT), INTENT(IN), VALUE :: arg - double_it = arg + arg - END FUNCTION double_it - - ! Call C function. - SUBROUTINE foobar () - TYPE(C_FUNPTR) :: cproc - INTEGER(KIND=C_INT) :: i - - ! Get C procedure pointer. - cproc = C_FUNLOC (double_it) - - ! Use it. - DO i = 1_C_INT, 10_C_INT - PRINT *, call_it (cproc, i) - END DO - END SUBROUTINE foobar - - END MODULE m - - -File: gfortran.info, Node: Further Interoperability of Fortran with C, Prev: Working with Pointers, Up: Interoperability with C - -7.1.6 Further Interoperability of Fortran with C ------------------------------------------------- - -The Technical Specification ISO/IEC TS 29113:2012 on further -interoperability of Fortran with C extends the interoperability support -of Fortran 2003 and Fortran 2008. Besides removing some restrictions -and constraints, it adds assumed-type ('TYPE(*)') and assumed-rank -('dimension') variables and allows for interoperability of -assumed-shape, assumed-rank and deferred-shape arrays, including -allocatables and pointers. - - Note: Currently, GNU Fortran does not support the array descriptor -(dope vector) as specified in the Technical Specification, but uses an -array descriptor with different fields. The Chasm Language -Interoperability Tools, <http://chasm-interop.sourceforge.net/>, provide -an interface to GNU Fortran's array descriptor. - - The Technical Specification adds the following new features, which -are supported by GNU Fortran: - - * The 'ASYNCHRONOUS' attribute has been clarified and extended to - allow its use with asynchronous communication in user-provided - libraries such as in implementations of the Message Passing - Interface specification. - - * Many constraints have been relaxed, in particular for the 'C_LOC' - and 'C_F_POINTER' intrinsics. - - * The 'OPTIONAL' attribute is now allowed for dummy arguments; an - absent argument matches a 'NULL' pointer. - - * Assumed types ('TYPE(*)') have been added, which may only be used - for dummy arguments. They are unlimited polymorphic but contrary - to 'CLASS(*)' they do not contain any type information, similar to - C's 'void *' pointers. Expressions of any type and kind can be - passed; thus, it can be used as replacement for 'TYPE(C_PTR)', - avoiding the use of 'C_LOC' in the caller. - - Note, however, that 'TYPE(*)' only accepts scalar arguments, unless - the 'DIMENSION' is explicitly specified. As 'DIMENSION(*)' only - supports array (including array elements) but no scalars, it is not - a full replacement for 'C_LOC'. On the other hand, assumed-type - assumed-rank dummy arguments ('TYPE(*), DIMENSION(..)') allow for - both scalars and arrays, but require special code on the callee - side to handle the array descriptor. - - * Assumed-rank arrays ('DIMENSION(..)') as dummy argument allow that - scalars and arrays of any rank can be passed as actual argument. - As the Technical Specification does not provide for direct means to - operate with them, they have to be used either from the C side or - be converted using 'C_LOC' and 'C_F_POINTER' to scalars or arrays - of a specific rank. The rank can be determined using the 'RANK' - intrinisic. - - Currently unimplemented: - - * GNU Fortran always uses an array descriptor, which does not match - the one of the Technical Specification. The - 'ISO_Fortran_binding.h' header file and the C functions it - specifies are not available. - - * Using assumed-shape, assumed-rank and deferred-shape arrays in - 'BIND(C)' procedures is not fully supported. In particular, C - interoperable strings of other length than one are not supported as - this requires the new array descriptor. - - -File: gfortran.info, Node: GNU Fortran Compiler Directives, Next: Non-Fortran Main Program, Prev: Interoperability with C, Up: Mixed-Language Programming - -7.2 GNU Fortran Compiler Directives -=================================== - -The Fortran standard describes how a conforming program shall behave; -however, the exact implementation is not standardized. In order to -allow the user to choose specific implementation details, compiler -directives can be used to set attributes of variables and procedures -which are not part of the standard. Whether a given attribute is -supported and its exact effects depend on both the operating system and -on the processor; see *note C Extensions: (gcc)Top. for details. - - For procedures and procedure pointers, the following attributes can -be used to change the calling convention: - - * 'CDECL' - standard C calling convention - * 'STDCALL' - convention where the called procedure pops the stack - * 'FASTCALL' - part of the arguments are passed via registers instead - using the stack - - Besides changing the calling convention, the attributes also -influence the decoration of the symbol name, e.g., by a leading -underscore or by a trailing at-sign followed by the number of bytes on -the stack. When assigning a procedure to a procedure pointer, both -should use the same calling convention. - - On some systems, procedures and global variables (module variables -and 'COMMON' blocks) need special handling to be accessible when they -are in a shared library. The following attributes are available: - - * 'DLLEXPORT' - provide a global pointer to a pointer in the DLL - * 'DLLIMPORT' - reference the function or variable using a global - pointer - - For dummy arguments, the 'NO_ARG_CHECK' attribute can be used; in -other compilers, it is also known as 'IGNORE_TKR'. For dummy arguments -with this attribute actual arguments of any type and kind (similar to -'TYPE(*)'), scalars and arrays of any rank (no equivalent in Fortran -standard) are accepted. As with 'TYPE(*)', the argument is unlimited -polymorphic and no type information is available. Additionally, the -argument may only be passed to dummy arguments with the 'NO_ARG_CHECK' -attribute and as argument to the 'PRESENT' intrinsic function and to -'C_LOC' of the 'ISO_C_BINDING' module. - - Variables with 'NO_ARG_CHECK' attribute shall be of assumed-type -('TYPE(*)'; recommended) or of type 'INTEGER', 'LOGICAL', 'REAL' or -'COMPLEX'. They shall not have the 'ALLOCATE', 'CODIMENSION', -'INTENT(OUT)', 'POINTER' or 'VALUE' attribute; furthermore, they shall -be either scalar or of assumed-size ('dimension(*)'). As 'TYPE(*)', the -'NO_ARG_CHECK' attribute requires an explicit interface. - - * 'NO_ARG_CHECK' - disable the type, kind and rank checking - - The attributes are specified using the syntax - - '!GCC$ ATTRIBUTES' ATTRIBUTE-LIST '::' VARIABLE-LIST - - where in free-form source code only whitespace is allowed before -'!GCC$' and in fixed-form source code '!GCC$', 'cGCC$' or '*GCC$' shall -start in the first column. - - For procedures, the compiler directives shall be placed into the body -of the procedure; for variables and procedure pointers, they shall be in -the same declaration part as the variable or procedure pointer. - - -File: gfortran.info, Node: Non-Fortran Main Program, Next: Naming and argument-passing conventions, Prev: GNU Fortran Compiler Directives, Up: Mixed-Language Programming - -7.3 Non-Fortran Main Program -============================ - -* Menu: - -* _gfortran_set_args:: Save command-line arguments -* _gfortran_set_options:: Set library option flags -* _gfortran_set_convert:: Set endian conversion -* _gfortran_set_record_marker:: Set length of record markers -* _gfortran_set_fpe:: Set when a Floating Point Exception should be raised -* _gfortran_set_max_subrecord_length:: Set subrecord length - -Even if you are doing mixed-language programming, it is very likely that -you do not need to know or use the information in this section. Since -it is about the internal structure of GNU Fortran, it may also change in -GCC minor releases. - - When you compile a 'PROGRAM' with GNU Fortran, a function with the -name 'main' (in the symbol table of the object file) is generated, which -initializes the libgfortran library and then calls the actual program -which uses the name 'MAIN__', for historic reasons. If you link GNU -Fortran compiled procedures to, e.g., a C or C++ program or to a Fortran -program compiled by a different compiler, the libgfortran library is not -initialized and thus a few intrinsic procedures do not work properly, -e.g. those for obtaining the command-line arguments. - - Therefore, if your 'PROGRAM' is not compiled with GNU Fortran and the -GNU Fortran compiled procedures require intrinsics relying on the -library initialization, you need to initialize the library yourself. -Using the default options, gfortran calls '_gfortran_set_args' and -'_gfortran_set_options'. The initialization of the former is needed if -the called procedures access the command line (and for backtracing); the -latter sets some flags based on the standard chosen or to enable -backtracing. In typical programs, it is not necessary to call any -initialization function. - - If your 'PROGRAM' is compiled with GNU Fortran, you shall not call -any of the following functions. The libgfortran initialization -functions are shown in C syntax but using C bindings they are also -accessible from Fortran. - - -File: gfortran.info, Node: _gfortran_set_args, Next: _gfortran_set_options, Up: Non-Fortran Main Program - -7.3.1 '_gfortran_set_args' -- Save command-line arguments ---------------------------------------------------------- - -_Description_: - '_gfortran_set_args' saves the command-line arguments; this - initialization is required if any of the command-line intrinsics is - called. Additionally, it shall be called if backtracing is enabled - (see '_gfortran_set_options'). - -_Syntax_: - 'void _gfortran_set_args (int argc, char *argv[])' - -_Arguments_: - ARGC number of command line argument strings - ARGV the command-line argument strings; argv[0] is - the pathname of the executable itself. - -_Example_: - int main (int argc, char *argv[]) - { - /* Initialize libgfortran. */ - _gfortran_set_args (argc, argv); - return 0; - } - - -File: gfortran.info, Node: _gfortran_set_options, Next: _gfortran_set_convert, Prev: _gfortran_set_args, Up: Non-Fortran Main Program - -7.3.2 '_gfortran_set_options' -- Set library option flags ---------------------------------------------------------- - -_Description_: - '_gfortran_set_options' sets several flags related to the Fortran - standard to be used, whether backtracing should be enabled and - whether range checks should be performed. The syntax allows for - upward compatibility since the number of passed flags is specified; - for non-passed flags, the default value is used. See also *note - Code Gen Options::. Please note that not all flags are actually - used. - -_Syntax_: - 'void _gfortran_set_options (int num, int options[])' - -_Arguments_: - NUM number of options passed - ARGV The list of flag values - -_option flag list_: - OPTION[0] Allowed standard; can give run-time errors if - e.g. an input-output edit descriptor is invalid - in a given standard. Possible values are - (bitwise or-ed) 'GFC_STD_F77' (1), - 'GFC_STD_F95_OBS' (2), 'GFC_STD_F95_DEL' (4), - 'GFC_STD_F95' (8), 'GFC_STD_F2003' (16), - 'GFC_STD_GNU' (32), 'GFC_STD_LEGACY' (64), - 'GFC_STD_F2008' (128), 'GFC_STD_F2008_OBS' (256) - and GFC_STD_F2008_TS (512). Default: - 'GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_F95 - | GFC_STD_F2003 | GFC_STD_F2008 | - GFC_STD_F2008_TS | GFC_STD_F2008_OBS | - GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY'. - OPTION[1] Standard-warning flag; prints a warning to - standard error. Default: 'GFC_STD_F95_DEL | - GFC_STD_LEGACY'. - OPTION[2] If non zero, enable pedantic checking. Default: - off. - OPTION[3] Unused. - OPTION[4] If non zero, enable backtracing on run-time - errors. Default: off. (Default in the - compiler: on.) Note: Installs a signal handler - and requires command-line initialization using - '_gfortran_set_args'. - OPTION[5] If non zero, supports signed zeros. Default: - enabled. - OPTION[6] Enables run-time checking. Possible values are - (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), - GFC_RTCHECK_ARRAY_TEMPS (2), - GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), - GFC_RTCHECK_POINTER (32). Default: disabled. - OPTION[7] Unused. - OPTION[8] Show a warning when invoking 'STOP' and 'ERROR - STOP' if a floating-point exception occurred. - Possible values are (bitwise or-ed) - 'GFC_FPE_INVALID' (1), 'GFC_FPE_DENORMAL' (2), - 'GFC_FPE_ZERO' (4), 'GFC_FPE_OVERFLOW' (8), - 'GFC_FPE_UNDERFLOW' (16), 'GFC_FPE_INEXACT' - (32). Default: None (0). (Default in the - compiler: 'GFC_FPE_INVALID | GFC_FPE_DENORMAL | - GFC_FPE_ZERO | GFC_FPE_OVERFLOW | - GFC_FPE_UNDERFLOW'.) - -_Example_: - /* Use gfortran 4.9 default options. */ - static int options[] = {68, 511, 0, 0, 1, 1, 0, 0, 31}; - _gfortran_set_options (9, &options); - - -File: gfortran.info, Node: _gfortran_set_convert, Next: _gfortran_set_record_marker, Prev: _gfortran_set_options, Up: Non-Fortran Main Program - -7.3.3 '_gfortran_set_convert' -- Set endian conversion ------------------------------------------------------- - -_Description_: - '_gfortran_set_convert' set the representation of data for - unformatted files. - -_Syntax_: - 'void _gfortran_set_convert (int conv)' - -_Arguments_: - CONV Endian conversion, possible values: - GFC_CONVERT_NATIVE (0, default), - GFC_CONVERT_SWAP (1), GFC_CONVERT_BIG (2), - GFC_CONVERT_LITTLE (3). - -_Example_: - int main (int argc, char *argv[]) - { - /* Initialize libgfortran. */ - _gfortran_set_args (argc, argv); - _gfortran_set_convert (1); - return 0; - } - - -File: gfortran.info, Node: _gfortran_set_record_marker, Next: _gfortran_set_fpe, Prev: _gfortran_set_convert, Up: Non-Fortran Main Program - -7.3.4 '_gfortran_set_record_marker' -- Set length of record markers -------------------------------------------------------------------- - -_Description_: - '_gfortran_set_record_marker' sets the length of record markers for - unformatted files. - -_Syntax_: - 'void _gfortran_set_record_marker (int val)' - -_Arguments_: - VAL Length of the record marker; valid values are 4 - and 8. Default is 4. - -_Example_: - int main (int argc, char *argv[]) - { - /* Initialize libgfortran. */ - _gfortran_set_args (argc, argv); - _gfortran_set_record_marker (8); - return 0; - } - - -File: gfortran.info, Node: _gfortran_set_fpe, Next: _gfortran_set_max_subrecord_length, Prev: _gfortran_set_record_marker, Up: Non-Fortran Main Program - -7.3.5 '_gfortran_set_fpe' -- Enable floating point exception traps ------------------------------------------------------------------- - -_Description_: - '_gfortran_set_fpe' enables floating point exception traps for the - specified exceptions. On most systems, this will result in a - SIGFPE signal being sent and the program being aborted. - -_Syntax_: - 'void _gfortran_set_fpe (int val)' - -_Arguments_: - OPTION[0] IEEE exceptions. Possible values are (bitwise - or-ed) zero (0, default) no trapping, - 'GFC_FPE_INVALID' (1), 'GFC_FPE_DENORMAL' (2), - 'GFC_FPE_ZERO' (4), 'GFC_FPE_OVERFLOW' (8), - 'GFC_FPE_UNDERFLOW' (16), and 'GFC_FPE_INEXACT' - (32). - -_Example_: - int main (int argc, char *argv[]) - { - /* Initialize libgfortran. */ - _gfortran_set_args (argc, argv); - /* FPE for invalid operations such as SQRT(-1.0). */ - _gfortran_set_fpe (1); - return 0; - } - - -File: gfortran.info, Node: _gfortran_set_max_subrecord_length, Prev: _gfortran_set_fpe, Up: Non-Fortran Main Program - -7.3.6 '_gfortran_set_max_subrecord_length' -- Set subrecord length ------------------------------------------------------------------- - -_Description_: - '_gfortran_set_max_subrecord_length' set the maximum length for a - subrecord. This option only makes sense for testing and debugging - of unformatted I/O. - -_Syntax_: - 'void _gfortran_set_max_subrecord_length (int val)' - -_Arguments_: - VAL the maximum length for a subrecord; the maximum - permitted value is 2147483639, which is also the - default. - -_Example_: - int main (int argc, char *argv[]) - { - /* Initialize libgfortran. */ - _gfortran_set_args (argc, argv); - _gfortran_set_max_subrecord_length (8); - return 0; - } - - -File: gfortran.info, Node: Naming and argument-passing conventions, Prev: Non-Fortran Main Program, Up: Mixed-Language Programming - -7.4 Naming and argument-passing conventions -=========================================== - -This section gives an overview about the naming convention of procedures -and global variables and about the argument passing conventions used by -GNU Fortran. If a C binding has been specified, the naming convention -and some of the argument-passing conventions change. If possible, -mixed-language and mixed-compiler projects should use the better defined -C binding for interoperability. See *note Interoperability with C::. - -* Menu: - -* Naming conventions:: -* Argument passing conventions:: - - -File: gfortran.info, Node: Naming conventions, Next: Argument passing conventions, Up: Naming and argument-passing conventions - -7.4.1 Naming conventions ------------------------- - -According the Fortran standard, valid Fortran names consist of a letter -between 'A' to 'Z', 'a' to 'z', digits '0', '1' to '9' and underscores -('_') with the restriction that names may only start with a letter. As -vendor extension, the dollar sign ('$') is additionally permitted with -the option '-fdollar-ok', but not as first character and only if the -target system supports it. - - By default, the procedure name is the lower-cased Fortran name with -an appended underscore ('_'); using '-fno-underscoring' no underscore is -appended while '-fsecond-underscore' appends two underscores. Depending -on the target system and the calling convention, the procedure might be -additionally dressed; for instance, on 32bit Windows with 'stdcall', an -at-sign '@' followed by an integer number is appended. For the changing -the calling convention, see *note GNU Fortran Compiler Directives::. - - For common blocks, the same convention is used, i.e. by default an -underscore is appended to the lower-cased Fortran name. Blank commons -have the name '__BLNK__'. - - For procedures and variables declared in the specification space of a -module, the name is formed by '__', followed by the lower-cased module -name, '_MOD_', and the lower-cased Fortran name. Note that no -underscore is appended. - - -File: gfortran.info, Node: Argument passing conventions, Prev: Naming conventions, Up: Naming and argument-passing conventions - -7.4.2 Argument passing conventions ----------------------------------- - -Subroutines do not return a value (matching C99's 'void') while -functions either return a value as specified in the platform ABI or the -result variable is passed as hidden argument to the function and no -result is returned. A hidden result variable is used when the result -variable is an array or of type 'CHARACTER'. - - Arguments are passed according to the platform ABI. In particular, -complex arguments might not be compatible to a struct with two real -components for the real and imaginary part. The argument passing -matches the one of C99's '_Complex'. Functions with scalar complex -result variables return their value and do not use a by-reference -argument. Note that with the '-ff2c' option, the argument passing is -modified and no longer completely matches the platform ABI. Some other -Fortran compilers use 'f2c' semantic by default; this might cause -problems with interoperablility. - - GNU Fortran passes most arguments by reference, i.e. by passing a -pointer to the data. Note that the compiler might use a temporary -variable into which the actual argument has been copied, if required -semantically (copy-in/copy-out). - - For arguments with 'ALLOCATABLE' and 'POINTER' attribute (including -procedure pointers), a pointer to the pointer is passed such that the -pointer address can be modified in the procedure. - - For dummy arguments with the 'VALUE' attribute: Scalar arguments of -the type 'INTEGER', 'LOGICAL', 'REAL' and 'COMPLEX' are passed by value -according to the platform ABI. (As vendor extension and not recommended, -using '%VAL()' in the call to a procedure has the same effect.) For -'TYPE(C_PTR)' and procedure pointers, the pointer itself is passed such -that it can be modified without affecting the caller. - - For Boolean ('LOGICAL') arguments, please note that GCC expects only -the integer value 0 and 1. If a GNU Fortran 'LOGICAL' variable contains -another integer value, the result is undefined. As some other Fortran -compilers use -1 for '.TRUE.', extra care has to be taken - such as -passing the value as 'INTEGER'. (The same value restriction also -applies to other front ends of GCC, e.g. to GCC's C99 compiler for -'_Bool' or GCC's Ada compiler for 'Boolean'.) - - For arguments of 'CHARACTER' type, the character length is passed as -hidden argument. For deferred-length strings, the value is passed by -reference, otherwise by value. The character length has the type -'INTEGER(kind=4)'. Note with C binding, 'CHARACTER(len=1)' result -variables are returned according to the platform ABI and no hidden -length argument is used for dummy arguments; with 'VALUE', those -variables are passed by value. - - For 'OPTIONAL' dummy arguments, an absent argument is denoted by a -NULL pointer, except for scalar dummy arguments of type 'INTEGER', -'LOGICAL', 'REAL' and 'COMPLEX' which have the 'VALUE' attribute. For -those, a hidden Boolean argument ('logical(kind=C_bool),value') is used -to indicate whether the argument is present. - - Arguments which are assumed-shape, assumed-rank or deferred-rank -arrays or, with '-fcoarray=lib', allocatable scalar coarrays use an -array descriptor. All other arrays pass the address of the first -element of the array. With '-fcoarray=lib', the token and the offset -belonging to nonallocatable coarrays dummy arguments are passed as -hidden argument along the character length hidden arguments. The token -is an oparque pointer identifying the coarray and the offset is a -passed-by-value integer of kind 'C_PTRDIFF_T', denoting the byte offset -between the base address of the coarray and the passed scalar or first -element of the passed array. - - The arguments are passed in the following order - * Result variable, when the function result is passed by reference - * Character length of the function result, if it is a of type - 'CHARACTER' and no C binding is used - * The arguments in the order in which they appear in the Fortran - declaration - * The the present status for optional arguments with value attribute, - which are internally passed by value - * The character length and/or coarray token and offset for the first - argument which is a 'CHARACTER' or a nonallocatable coarray dummy - argument, followed by the hidden arguments of the next dummy - argument of such a type - - -File: gfortran.info, Node: Intrinsic Procedures, Next: Intrinsic Modules, Prev: Mixed-Language Programming, Up: Top - -8 Intrinsic Procedures -********************** - -* Menu: - -* Introduction: Introduction to Intrinsics -* 'ABORT': ABORT, Abort the program -* 'ABS': ABS, Absolute value -* 'ACCESS': ACCESS, Checks file access modes -* 'ACHAR': ACHAR, Character in ASCII collating sequence -* 'ACOS': ACOS, Arccosine function -* 'ACOSH': ACOSH, Inverse hyperbolic cosine function -* 'ADJUSTL': ADJUSTL, Left adjust a string -* 'ADJUSTR': ADJUSTR, Right adjust a string -* 'AIMAG': AIMAG, Imaginary part of complex number -* 'AINT': AINT, Truncate to a whole number -* 'ALARM': ALARM, Set an alarm clock -* 'ALL': ALL, Determine if all values are true -* 'ALLOCATED': ALLOCATED, Status of allocatable entity -* 'AND': AND, Bitwise logical AND -* 'ANINT': ANINT, Nearest whole number -* 'ANY': ANY, Determine if any values are true -* 'ASIN': ASIN, Arcsine function -* 'ASINH': ASINH, Inverse hyperbolic sine function -* 'ASSOCIATED': ASSOCIATED, Status of a pointer or pointer/target pair -* 'ATAN': ATAN, Arctangent function -* 'ATAN2': ATAN2, Arctangent function -* 'ATANH': ATANH, Inverse hyperbolic tangent function -* 'ATOMIC_DEFINE': ATOMIC_DEFINE, Setting a variable atomically -* 'ATOMIC_REF': ATOMIC_REF, Obtaining the value of a variable atomically -* 'BACKTRACE': BACKTRACE, Show a backtrace -* 'BESSEL_J0': BESSEL_J0, Bessel function of the first kind of order 0 -* 'BESSEL_J1': BESSEL_J1, Bessel function of the first kind of order 1 -* 'BESSEL_JN': BESSEL_JN, Bessel function of the first kind -* 'BESSEL_Y0': BESSEL_Y0, Bessel function of the second kind of order 0 -* 'BESSEL_Y1': BESSEL_Y1, Bessel function of the second kind of order 1 -* 'BESSEL_YN': BESSEL_YN, Bessel function of the second kind -* 'BGE': BGE, Bitwise greater than or equal to -* 'BGT': BGT, Bitwise greater than -* 'BIT_SIZE': BIT_SIZE, Bit size inquiry function -* 'BLE': BLE, Bitwise less than or equal to -* 'BLT': BLT, Bitwise less than -* 'BTEST': BTEST, Bit test function -* 'C_ASSOCIATED': C_ASSOCIATED, Status of a C pointer -* 'C_F_POINTER': C_F_POINTER, Convert C into Fortran pointer -* 'C_F_PROCPOINTER': C_F_PROCPOINTER, Convert C into Fortran procedure pointer -* 'C_FUNLOC': C_FUNLOC, Obtain the C address of a procedure -* 'C_LOC': C_LOC, Obtain the C address of an object -* 'C_SIZEOF': C_SIZEOF, Size in bytes of an expression -* 'CEILING': CEILING, Integer ceiling function -* 'CHAR': CHAR, Integer-to-character conversion function -* 'CHDIR': CHDIR, Change working directory -* 'CHMOD': CHMOD, Change access permissions of files -* 'CMPLX': CMPLX, Complex conversion function -* 'COMMAND_ARGUMENT_COUNT': COMMAND_ARGUMENT_COUNT, Get number of command line arguments -* 'COMPILER_OPTIONS': COMPILER_OPTIONS, Options passed to the compiler -* 'COMPILER_VERSION': COMPILER_VERSION, Compiler version string -* 'COMPLEX': COMPLEX, Complex conversion function -* 'CONJG': CONJG, Complex conjugate function -* 'COS': COS, Cosine function -* 'COSH': COSH, Hyperbolic cosine function -* 'COUNT': COUNT, Count occurrences of TRUE in an array -* 'CPU_TIME': CPU_TIME, CPU time subroutine -* 'CSHIFT': CSHIFT, Circular shift elements of an array -* 'CTIME': CTIME, Subroutine (or function) to convert a time into a string -* 'DATE_AND_TIME': DATE_AND_TIME, Date and time subroutine -* 'DBLE': DBLE, Double precision conversion function -* 'DCMPLX': DCMPLX, Double complex conversion function -* 'DIGITS': DIGITS, Significant digits function -* 'DIM': DIM, Positive difference -* 'DOT_PRODUCT': DOT_PRODUCT, Dot product function -* 'DPROD': DPROD, Double product function -* 'DREAL': DREAL, Double real part function -* 'DSHIFTL': DSHIFTL, Combined left shift -* 'DSHIFTR': DSHIFTR, Combined right shift -* 'DTIME': DTIME, Execution time subroutine (or function) -* 'EOSHIFT': EOSHIFT, End-off shift elements of an array -* 'EPSILON': EPSILON, Epsilon function -* 'ERF': ERF, Error function -* 'ERFC': ERFC, Complementary error function -* 'ERFC_SCALED': ERFC_SCALED, Exponentially-scaled complementary error function -* 'ETIME': ETIME, Execution time subroutine (or function) -* 'EXECUTE_COMMAND_LINE': EXECUTE_COMMAND_LINE, Execute a shell command -* 'EXIT': EXIT, Exit the program with status. -* 'EXP': EXP, Exponential function -* 'EXPONENT': EXPONENT, Exponent function -* 'EXTENDS_TYPE_OF': EXTENDS_TYPE_OF, Query dynamic type for extension -* 'FDATE': FDATE, Subroutine (or function) to get the current time as a string -* 'FGET': FGET, Read a single character in stream mode from stdin -* 'FGETC': FGETC, Read a single character in stream mode -* 'FLOOR': FLOOR, Integer floor function -* 'FLUSH': FLUSH, Flush I/O unit(s) -* 'FNUM': FNUM, File number function -* 'FPUT': FPUT, Write a single character in stream mode to stdout -* 'FPUTC': FPUTC, Write a single character in stream mode -* 'FRACTION': FRACTION, Fractional part of the model representation -* 'FREE': FREE, Memory de-allocation subroutine -* 'FSEEK': FSEEK, Low level file positioning subroutine -* 'FSTAT': FSTAT, Get file status -* 'FTELL': FTELL, Current stream position -* 'GAMMA': GAMMA, Gamma function -* 'GERROR': GERROR, Get last system error message -* 'GETARG': GETARG, Get command line arguments -* 'GET_COMMAND': GET_COMMAND, Get the entire command line -* 'GET_COMMAND_ARGUMENT': GET_COMMAND_ARGUMENT, Get command line arguments -* 'GETCWD': GETCWD, Get current working directory -* 'GETENV': GETENV, Get an environmental variable -* 'GET_ENVIRONMENT_VARIABLE': GET_ENVIRONMENT_VARIABLE, Get an environmental variable -* 'GETGID': GETGID, Group ID function -* 'GETLOG': GETLOG, Get login name -* 'GETPID': GETPID, Process ID function -* 'GETUID': GETUID, User ID function -* 'GMTIME': GMTIME, Convert time to GMT info -* 'HOSTNM': HOSTNM, Get system host name -* 'HUGE': HUGE, Largest number of a kind -* 'HYPOT': HYPOT, Euclidean distance function -* 'IACHAR': IACHAR, Code in ASCII collating sequence -* 'IALL': IALL, Bitwise AND of array elements -* 'IAND': IAND, Bitwise logical and -* 'IANY': IANY, Bitwise OR of array elements -* 'IARGC': IARGC, Get the number of command line arguments -* 'IBCLR': IBCLR, Clear bit -* 'IBITS': IBITS, Bit extraction -* 'IBSET': IBSET, Set bit -* 'ICHAR': ICHAR, Character-to-integer conversion function -* 'IDATE': IDATE, Current local time (day/month/year) -* 'IEOR': IEOR, Bitwise logical exclusive or -* 'IERRNO': IERRNO, Function to get the last system error number -* 'IMAGE_INDEX': IMAGE_INDEX, Cosubscript to image index conversion -* 'INDEX': INDEX intrinsic, Position of a substring within a string -* 'INT': INT, Convert to integer type -* 'INT2': INT2, Convert to 16-bit integer type -* 'INT8': INT8, Convert to 64-bit integer type -* 'IOR': IOR, Bitwise logical or -* 'IPARITY': IPARITY, Bitwise XOR of array elements -* 'IRAND': IRAND, Integer pseudo-random number -* 'IS_IOSTAT_END': IS_IOSTAT_END, Test for end-of-file value -* 'IS_IOSTAT_EOR': IS_IOSTAT_EOR, Test for end-of-record value -* 'ISATTY': ISATTY, Whether a unit is a terminal device -* 'ISHFT': ISHFT, Shift bits -* 'ISHFTC': ISHFTC, Shift bits circularly -* 'ISNAN': ISNAN, Tests for a NaN -* 'ITIME': ITIME, Current local time (hour/minutes/seconds) -* 'KILL': KILL, Send a signal to a process -* 'KIND': KIND, Kind of an entity -* 'LBOUND': LBOUND, Lower dimension bounds of an array -* 'LCOBOUND': LCOBOUND, Lower codimension bounds of an array -* 'LEADZ': LEADZ, Number of leading zero bits of an integer -* 'LEN': LEN, Length of a character entity -* 'LEN_TRIM': LEN_TRIM, Length of a character entity without trailing blank characters -* 'LGE': LGE, Lexical greater than or equal -* 'LGT': LGT, Lexical greater than -* 'LINK': LINK, Create a hard link -* 'LLE': LLE, Lexical less than or equal -* 'LLT': LLT, Lexical less than -* 'LNBLNK': LNBLNK, Index of the last non-blank character in a string -* 'LOC': LOC, Returns the address of a variable -* 'LOG': LOG, Logarithm function -* 'LOG10': LOG10, Base 10 logarithm function -* 'LOG_GAMMA': LOG_GAMMA, Logarithm of the Gamma function -* 'LOGICAL': LOGICAL, Convert to logical type -* 'LONG': LONG, Convert to integer type -* 'LSHIFT': LSHIFT, Left shift bits -* 'LSTAT': LSTAT, Get file status -* 'LTIME': LTIME, Convert time to local time info -* 'MALLOC': MALLOC, Dynamic memory allocation function -* 'MASKL': MASKL, Left justified mask -* 'MASKR': MASKR, Right justified mask -* 'MATMUL': MATMUL, matrix multiplication -* 'MAX': MAX, Maximum value of an argument list -* 'MAXEXPONENT': MAXEXPONENT, Maximum exponent of a real kind -* 'MAXLOC': MAXLOC, Location of the maximum value within an array -* 'MAXVAL': MAXVAL, Maximum value of an array -* 'MCLOCK': MCLOCK, Time function -* 'MCLOCK8': MCLOCK8, Time function (64-bit) -* 'MERGE': MERGE, Merge arrays -* 'MERGE_BITS': MERGE_BITS, Merge of bits under mask -* 'MIN': MIN, Minimum value of an argument list -* 'MINEXPONENT': MINEXPONENT, Minimum exponent of a real kind -* 'MINLOC': MINLOC, Location of the minimum value within an array -* 'MINVAL': MINVAL, Minimum value of an array -* 'MOD': MOD, Remainder function -* 'MODULO': MODULO, Modulo function -* 'MOVE_ALLOC': MOVE_ALLOC, Move allocation from one object to another -* 'MVBITS': MVBITS, Move bits from one integer to another -* 'NEAREST': NEAREST, Nearest representable number -* 'NEW_LINE': NEW_LINE, New line character -* 'NINT': NINT, Nearest whole number -* 'NORM2': NORM2, Euclidean vector norm -* 'NOT': NOT, Logical negation -* 'NULL': NULL, Function that returns an disassociated pointer -* 'NUM_IMAGES': NUM_IMAGES, Number of images -* 'OR': OR, Bitwise logical OR -* 'PACK': PACK, Pack an array into an array of rank one -* 'PARITY': PARITY, Reduction with exclusive OR -* 'PERROR': PERROR, Print system error message -* 'POPCNT': POPCNT, Number of bits set -* 'POPPAR': POPPAR, Parity of the number of bits set -* 'PRECISION': PRECISION, Decimal precision of a real kind -* 'PRESENT': PRESENT, Determine whether an optional dummy argument is specified -* 'PRODUCT': PRODUCT, Product of array elements -* 'RADIX': RADIX, Base of a data model -* 'RAN': RAN, Real pseudo-random number -* 'RAND': RAND, Real pseudo-random number -* 'RANDOM_NUMBER': RANDOM_NUMBER, Pseudo-random number -* 'RANDOM_SEED': RANDOM_SEED, Initialize a pseudo-random number sequence -* 'RANGE': RANGE, Decimal exponent range -* 'RANK' : RANK, Rank of a data object -* 'REAL': REAL, Convert to real type -* 'RENAME': RENAME, Rename a file -* 'REPEAT': REPEAT, Repeated string concatenation -* 'RESHAPE': RESHAPE, Function to reshape an array -* 'RRSPACING': RRSPACING, Reciprocal of the relative spacing -* 'RSHIFT': RSHIFT, Right shift bits -* 'SAME_TYPE_AS': SAME_TYPE_AS, Query dynamic types for equality -* 'SCALE': SCALE, Scale a real value -* 'SCAN': SCAN, Scan a string for the presence of a set of characters -* 'SECNDS': SECNDS, Time function -* 'SECOND': SECOND, CPU time function -* 'SELECTED_CHAR_KIND': SELECTED_CHAR_KIND, Choose character kind -* 'SELECTED_INT_KIND': SELECTED_INT_KIND, Choose integer kind -* 'SELECTED_REAL_KIND': SELECTED_REAL_KIND, Choose real kind -* 'SET_EXPONENT': SET_EXPONENT, Set the exponent of the model -* 'SHAPE': SHAPE, Determine the shape of an array -* 'SHIFTA': SHIFTA, Right shift with fill -* 'SHIFTL': SHIFTL, Left shift -* 'SHIFTR': SHIFTR, Right shift -* 'SIGN': SIGN, Sign copying function -* 'SIGNAL': SIGNAL, Signal handling subroutine (or function) -* 'SIN': SIN, Sine function -* 'SINH': SINH, Hyperbolic sine function -* 'SIZE': SIZE, Function to determine the size of an array -* 'SIZEOF': SIZEOF, Determine the size in bytes of an expression -* 'SLEEP': SLEEP, Sleep for the specified number of seconds -* 'SPACING': SPACING, Smallest distance between two numbers of a given type -* 'SPREAD': SPREAD, Add a dimension to an array -* 'SQRT': SQRT, Square-root function -* 'SRAND': SRAND, Reinitialize the random number generator -* 'STAT': STAT, Get file status -* 'STORAGE_SIZE': STORAGE_SIZE, Storage size in bits -* 'SUM': SUM, Sum of array elements -* 'SYMLNK': SYMLNK, Create a symbolic link -* 'SYSTEM': SYSTEM, Execute a shell command -* 'SYSTEM_CLOCK': SYSTEM_CLOCK, Time function -* 'TAN': TAN, Tangent function -* 'TANH': TANH, Hyperbolic tangent function -* 'THIS_IMAGE': THIS_IMAGE, Cosubscript index of this image -* 'TIME': TIME, Time function -* 'TIME8': TIME8, Time function (64-bit) -* 'TINY': TINY, Smallest positive number of a real kind -* 'TRAILZ': TRAILZ, Number of trailing zero bits of an integer -* 'TRANSFER': TRANSFER, Transfer bit patterns -* 'TRANSPOSE': TRANSPOSE, Transpose an array of rank two -* 'TRIM': TRIM, Remove trailing blank characters of a string -* 'TTYNAM': TTYNAM, Get the name of a terminal device. -* 'UBOUND': UBOUND, Upper dimension bounds of an array -* 'UCOBOUND': UCOBOUND, Upper codimension bounds of an array -* 'UMASK': UMASK, Set the file creation mask -* 'UNLINK': UNLINK, Remove a file from the file system -* 'UNPACK': UNPACK, Unpack an array of rank one into an array -* 'VERIFY': VERIFY, Scan a string for the absence of a set of characters -* 'XOR': XOR, Bitwise logical exclusive or - - -File: gfortran.info, Node: Introduction to Intrinsics, Next: ABORT, Up: Intrinsic Procedures - -8.1 Introduction to intrinsic procedures -======================================== - -The intrinsic procedures provided by GNU Fortran include all of the -intrinsic procedures required by the Fortran 95 standard, a set of -intrinsic procedures for backwards compatibility with G77, and a -selection of intrinsic procedures from the Fortran 2003 and Fortran 2008 -standards. Any conflict between a description here and a description in -either the Fortran 95 standard, the Fortran 2003 standard or the Fortran -2008 standard is unintentional, and the standard(s) should be considered -authoritative. - - The enumeration of the 'KIND' type parameter is processor defined in -the Fortran 95 standard. GNU Fortran defines the default integer type -and default real type by 'INTEGER(KIND=4)' and 'REAL(KIND=4)', -respectively. The standard mandates that both data types shall have -another kind, which have more precision. On typical target -architectures supported by 'gfortran', this kind type parameter is -'KIND=8'. Hence, 'REAL(KIND=8)' and 'DOUBLE PRECISION' are equivalent. -In the description of generic intrinsic procedures, the kind type -parameter will be specified by 'KIND=*', and in the description of -specific names for an intrinsic procedure the kind type parameter will -be explicitly given (e.g., 'REAL(KIND=4)' or 'REAL(KIND=8)'). Finally, -for brevity the optional 'KIND=' syntax will be omitted. - - Many of the intrinsic procedures take one or more optional arguments. -This document follows the convention used in the Fortran 95 standard, -and denotes such arguments by square brackets. - - GNU Fortran offers the '-std=f95' and '-std=gnu' options, which can -be used to restrict the set of intrinsic procedures to a given standard. -By default, 'gfortran' sets the '-std=gnu' option, and so all intrinsic -procedures described here are accepted. There is one caveat. For a -select group of intrinsic procedures, 'g77' implemented both a function -and a subroutine. Both classes have been implemented in 'gfortran' for -backwards compatibility with 'g77'. It is noted here that these -functions and subroutines cannot be intermixed in a given subprogram. -In the descriptions that follow, the applicable standard for each -intrinsic procedure is noted. - - -File: gfortran.info, Node: ABORT, Next: ABS, Prev: Introduction to Intrinsics, Up: Intrinsic Procedures - -8.2 'ABORT' -- Abort the program -================================ - -_Description_: - 'ABORT' causes immediate termination of the program. On operating - systems that support a core dump, 'ABORT' will produce a core dump. - It will also print a backtrace, unless '-fno-backtrace' is given. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL ABORT' - -_Return value_: - Does not return. - -_Example_: - program test_abort - integer :: i = 1, j = 2 - if (i /= j) call abort - end program test_abort - -_See also_: - *note EXIT::, *note KILL::, *note BACKTRACE:: - - -File: gfortran.info, Node: ABS, Next: ACCESS, Prev: ABORT, Up: Intrinsic Procedures - -8.3 'ABS' -- Absolute value -=========================== - -_Description_: - 'ABS(A)' computes the absolute value of 'A'. - -_Standard_: - Fortran 77 and later, has overloads that are GNU extensions - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ABS(A)' - -_Arguments_: - A The type of the argument shall be an 'INTEGER', - 'REAL', or 'COMPLEX'. - -_Return value_: - The return value is of the same type and kind as the argument - except the return value is 'REAL' for a 'COMPLEX' argument. - -_Example_: - program test_abs - integer :: i = -1 - real :: x = -1.e0 - complex :: z = (-1.e0,0.e0) - i = abs(i) - x = abs(x) - x = abs(z) - end program test_abs - -_Specific names_: - Name Argument Return type Standard - 'ABS(A)' 'REAL(4) A' 'REAL(4)' Fortran 77 and - later - 'CABS(A)' 'COMPLEX(4) 'REAL(4)' Fortran 77 and - A' later - 'DABS(A)' 'REAL(8) A' 'REAL(8)' Fortran 77 and - later - 'IABS(A)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and - A' later - 'ZABS(A)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - A' - 'CDABS(A)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - A' - - -File: gfortran.info, Node: ACCESS, Next: ACHAR, Prev: ABS, Up: Intrinsic Procedures - -8.4 'ACCESS' -- Checks file access modes -======================================== - -_Description_: - 'ACCESS(NAME, MODE)' checks whether the file NAME exists, is - readable, writable or executable. Except for the executable check, - 'ACCESS' can be replaced by Fortran 95's 'INQUIRE'. - -_Standard_: - GNU extension - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = ACCESS(NAME, MODE)' - -_Arguments_: - NAME Scalar 'CHARACTER' of default kind with the file - name. Tailing blank are ignored unless the - character 'achar(0)' is present, then all - characters up to and excluding 'achar(0)' are - used as file name. - MODE Scalar 'CHARACTER' of default kind with the file - access mode, may be any concatenation of '"r"' - (readable), '"w"' (writable) and '"x"' - (executable), or '" "' to check for existence. - -_Return value_: - Returns a scalar 'INTEGER', which is '0' if the file is accessible - in the given mode; otherwise or if an invalid argument has been - given for 'MODE' the value '1' is returned. - -_Example_: - program access_test - implicit none - character(len=*), parameter :: file = 'test.dat' - character(len=*), parameter :: file2 = 'test.dat '//achar(0) - if(access(file,' ') == 0) print *, trim(file),' is exists' - if(access(file,'r') == 0) print *, trim(file),' is readable' - if(access(file,'w') == 0) print *, trim(file),' is writable' - if(access(file,'x') == 0) print *, trim(file),' is executable' - if(access(file2,'rwx') == 0) & - print *, trim(file2),' is readable, writable and executable' - end program access_test -_Specific names_: -_See also_: - - -File: gfortran.info, Node: ACHAR, Next: ACOS, Prev: ACCESS, Up: Intrinsic Procedures - -8.5 'ACHAR' -- Character in ASCII collating sequence -==================================================== - -_Description_: - 'ACHAR(I)' returns the character located at position 'I' in the - ASCII collating sequence. - -_Standard_: - Fortran 77 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ACHAR(I [, KIND])' - -_Arguments_: - I The type shall be 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'CHARACTER' with a length of one. If - the KIND argument is present, the return value is of the specified - kind and of the default kind otherwise. - -_Example_: - program test_achar - character c - c = achar(32) - end program test_achar - -_Note_: - See *note ICHAR:: for a discussion of converting between numerical - values and formatted string representations. - -_See also_: - *note CHAR::, *note IACHAR::, *note ICHAR:: - - -File: gfortran.info, Node: ACOS, Next: ACOSH, Prev: ACHAR, Up: Intrinsic Procedures - -8.6 'ACOS' -- Arccosine function -================================ - -_Description_: - 'ACOS(X)' computes the arccosine of X (inverse of 'COS(X)'). - -_Standard_: - Fortran 77 and later, for a complex argument Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ACOS(X)' - -_Arguments_: - X The type shall either be 'REAL' with a magnitude - that is less than or equal to one - or the type - shall be 'COMPLEX'. - -_Return value_: - The return value is of the same type and kind as X. The real part - of the result is in radians and lies in the range 0 \leq \Re - \acos(x) \leq \pi. - -_Example_: - program test_acos - real(8) :: x = 0.866_8 - x = acos(x) - end program test_acos - -_Specific names_: - Name Argument Return type Standard - 'ACOS(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and - later - 'DACOS(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and - later - -_See also_: - Inverse function: *note COS:: - - -File: gfortran.info, Node: ACOSH, Next: ADJUSTL, Prev: ACOS, Up: Intrinsic Procedures - -8.7 'ACOSH' -- Inverse hyperbolic cosine function -================================================= - -_Description_: - 'ACOSH(X)' computes the inverse hyperbolic cosine of X. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ACOSH(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has the same type and kind as X. If X is complex, - the imaginary part of the result is in radians and lies between 0 - \leq \Im \acosh(x) \leq \pi. - -_Example_: - PROGRAM test_acosh - REAL(8), DIMENSION(3) :: x = (/ 1.0, 2.0, 3.0 /) - WRITE (*,*) ACOSH(x) - END PROGRAM - -_Specific names_: - Name Argument Return type Standard - 'DACOSH(X)' 'REAL(8) X' 'REAL(8)' GNU extension - -_See also_: - Inverse function: *note COSH:: - - -File: gfortran.info, Node: ADJUSTL, Next: ADJUSTR, Prev: ACOSH, Up: Intrinsic Procedures - -8.8 'ADJUSTL' -- Left adjust a string -===================================== - -_Description_: - 'ADJUSTL(STRING)' will left adjust a string by removing leading - spaces. Spaces are inserted at the end of the string as needed. - -_Standard_: - Fortran 90 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ADJUSTL(STRING)' - -_Arguments_: - STRING The type shall be 'CHARACTER'. - -_Return value_: - The return value is of type 'CHARACTER' and of the same kind as - STRING where leading spaces are removed and the same number of - spaces are inserted on the end of STRING. - -_Example_: - program test_adjustl - character(len=20) :: str = ' gfortran' - str = adjustl(str) - print *, str - end program test_adjustl - -_See also_: - *note ADJUSTR::, *note TRIM:: - - -File: gfortran.info, Node: ADJUSTR, Next: AIMAG, Prev: ADJUSTL, Up: Intrinsic Procedures - -8.9 'ADJUSTR' -- Right adjust a string -====================================== - -_Description_: - 'ADJUSTR(STRING)' will right adjust a string by removing trailing - spaces. Spaces are inserted at the start of the string as needed. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ADJUSTR(STRING)' - -_Arguments_: - STR The type shall be 'CHARACTER'. - -_Return value_: - The return value is of type 'CHARACTER' and of the same kind as - STRING where trailing spaces are removed and the same number of - spaces are inserted at the start of STRING. - -_Example_: - program test_adjustr - character(len=20) :: str = 'gfortran' - str = adjustr(str) - print *, str - end program test_adjustr - -_See also_: - *note ADJUSTL::, *note TRIM:: - - -File: gfortran.info, Node: AIMAG, Next: AINT, Prev: ADJUSTR, Up: Intrinsic Procedures - -8.10 'AIMAG' -- Imaginary part of complex number -================================================ - -_Description_: - 'AIMAG(Z)' yields the imaginary part of complex argument 'Z'. The - 'IMAG(Z)' and 'IMAGPART(Z)' intrinsic functions are provided for - compatibility with 'g77', and their use in new code is strongly - discouraged. - -_Standard_: - Fortran 77 and later, has overloads that are GNU extensions - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = AIMAG(Z)' - -_Arguments_: - Z The type of the argument shall be 'COMPLEX'. - -_Return value_: - The return value is of type 'REAL' with the kind type parameter of - the argument. - -_Example_: - program test_aimag - complex(4) z4 - complex(8) z8 - z4 = cmplx(1.e0_4, 0.e0_4) - z8 = cmplx(0.e0_8, 1.e0_8) - print *, aimag(z4), dimag(z8) - end program test_aimag - -_Specific names_: - Name Argument Return type Standard - 'AIMAG(Z)' 'COMPLEX Z' 'REAL' GNU extension - 'DIMAG(Z)' 'COMPLEX(8) 'REAL(8)' GNU extension - Z' - 'IMAG(Z)' 'COMPLEX Z' 'REAL' GNU extension - 'IMAGPART(Z)' 'COMPLEX Z' 'REAL' GNU extension - - -File: gfortran.info, Node: AINT, Next: ALARM, Prev: AIMAG, Up: Intrinsic Procedures - -8.11 'AINT' -- Truncate to a whole number -========================================= - -_Description_: - 'AINT(A [, KIND])' truncates its argument to a whole number. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = AINT(A [, KIND])' - -_Arguments_: - A The type of the argument shall be 'REAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'REAL' with the kind type parameter of - the argument if the optional KIND is absent; otherwise, the kind - type parameter will be given by KIND. If the magnitude of X is - less than one, 'AINT(X)' returns zero. If the magnitude is equal - to or greater than one then it returns the largest whole number - that does not exceed its magnitude. The sign is the same as the - sign of X. - -_Example_: - program test_aint - real(4) x4 - real(8) x8 - x4 = 1.234E0_4 - x8 = 4.321_8 - print *, aint(x4), dint(x8) - x8 = aint(x4,8) - end program test_aint - -_Specific names_: - Name Argument Return type Standard - 'AINT(A)' 'REAL(4) A' 'REAL(4)' Fortran 77 and - later - 'DINT(A)' 'REAL(8) A' 'REAL(8)' Fortran 77 and - later - - -File: gfortran.info, Node: ALARM, Next: ALL, Prev: AINT, Up: Intrinsic Procedures - -8.12 'ALARM' -- Execute a routine after a given delay -===================================================== - -_Description_: - 'ALARM(SECONDS, HANDLER [, STATUS])' causes external subroutine - HANDLER to be executed after a delay of SECONDS by using 'alarm(2)' - to set up a signal and 'signal(2)' to catch it. If STATUS is - supplied, it will be returned with the number of seconds remaining - until any previously scheduled alarm was due to be delivered, or - zero if there was no previously scheduled alarm. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL ALARM(SECONDS, HANDLER [, STATUS])' - -_Arguments_: - SECONDS The type of the argument shall be a scalar - 'INTEGER'. It is 'INTENT(IN)'. - HANDLER Signal handler ('INTEGER FUNCTION' or - 'SUBROUTINE') or dummy/global 'INTEGER' scalar. - The scalar values may be either 'SIG_IGN=1' to - ignore the alarm generated or 'SIG_DFL=0' to set - the default action. It is 'INTENT(IN)'. - STATUS (Optional) STATUS shall be a scalar variable of - the default 'INTEGER' kind. It is - 'INTENT(OUT)'. - -_Example_: - program test_alarm - external handler_print - integer i - call alarm (3, handler_print, i) - print *, i - call sleep(10) - end program test_alarm - This will cause the external routine HANDLER_PRINT to be called - after 3 seconds. - - -File: gfortran.info, Node: ALL, Next: ALLOCATED, Prev: ALARM, Up: Intrinsic Procedures - -8.13 'ALL' -- All values in MASK along DIM are true -=================================================== - -_Description_: - 'ALL(MASK [, DIM])' determines if all the values are true in MASK - in the array along dimension DIM. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = ALL(MASK [, DIM])' - -_Arguments_: - MASK The type of the argument shall be 'LOGICAL' and - it shall not be scalar. - DIM (Optional) DIM shall be a scalar integer with a - value that lies between one and the rank of - MASK. - -_Return value_: - 'ALL(MASK)' returns a scalar value of type 'LOGICAL' where the kind - type parameter is the same as the kind type parameter of MASK. If - DIM is present, then 'ALL(MASK, DIM)' returns an array with the - rank of MASK minus 1. The shape is determined from the shape of - MASK where the DIM dimension is elided. - - (A) - 'ALL(MASK)' is true if all elements of MASK are true. It also - is true if MASK has zero size; otherwise, it is false. - (B) - If the rank of MASK is one, then 'ALL(MASK,DIM)' is equivalent - to 'ALL(MASK)'. If the rank is greater than one, then - 'ALL(MASK,DIM)' is determined by applying 'ALL' to the array - sections. - -_Example_: - program test_all - logical l - l = all((/.true., .true., .true./)) - print *, l - call section - contains - subroutine section - integer a(2,3), b(2,3) - a = 1 - b = 1 - b(2,2) = 2 - print *, all(a .eq. b, 1) - print *, all(a .eq. b, 2) - end subroutine section - end program test_all - - -File: gfortran.info, Node: ALLOCATED, Next: AND, Prev: ALL, Up: Intrinsic Procedures - -8.14 'ALLOCATED' -- Status of an allocatable entity -=================================================== - -_Description_: - 'ALLOCATED(ARRAY)' and 'ALLOCATED(SCALAR)' check the allocation - status of ARRAY and SCALAR, respectively. - -_Standard_: - Fortran 95 and later. Note, the 'SCALAR=' keyword and allocatable - scalar entities are available in Fortran 2003 and later. - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = ALLOCATED(ARRAY)' - 'RESULT = ALLOCATED(SCALAR)' - -_Arguments_: - ARRAY The argument shall be an 'ALLOCATABLE' array. - SCALAR The argument shall be an 'ALLOCATABLE' scalar. - -_Return value_: - The return value is a scalar 'LOGICAL' with the default logical - kind type parameter. If the argument is allocated, then the result - is '.TRUE.'; otherwise, it returns '.FALSE.' - -_Example_: - program test_allocated - integer :: i = 4 - real(4), allocatable :: x(:) - if (.not. allocated(x)) allocate(x(i)) - end program test_allocated - - -File: gfortran.info, Node: AND, Next: ANINT, Prev: ALLOCATED, Up: Intrinsic Procedures - -8.15 'AND' -- Bitwise logical AND -================================= - -_Description_: - Bitwise logical 'AND'. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. For integer arguments, programmers should consider - the use of the *note IAND:: intrinsic defined by the Fortran - standard. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = AND(I, J)' - -_Arguments_: - I The type shall be either a scalar 'INTEGER' type - or a scalar 'LOGICAL' type. - J The type shall be the same as the type of I. - -_Return value_: - The return type is either a scalar 'INTEGER' or a scalar 'LOGICAL'. - If the kind type parameters differ, then the smaller kind type is - implicitly converted to larger kind, and the return has the larger - kind. - -_Example_: - PROGRAM test_and - LOGICAL :: T = .TRUE., F = .FALSE. - INTEGER :: a, b - DATA a / Z'F' /, b / Z'3' / - - WRITE (*,*) AND(T, T), AND(T, F), AND(F, T), AND(F, F) - WRITE (*,*) AND(a, b) - END PROGRAM - -_See also_: - Fortran 95 elemental function: *note IAND:: - - -File: gfortran.info, Node: ANINT, Next: ANY, Prev: AND, Up: Intrinsic Procedures - -8.16 'ANINT' -- Nearest whole number -==================================== - -_Description_: - 'ANINT(A [, KIND])' rounds its argument to the nearest whole - number. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ANINT(A [, KIND])' - -_Arguments_: - A The type of the argument shall be 'REAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type real with the kind type parameter of - the argument if the optional KIND is absent; otherwise, the kind - type parameter will be given by KIND. If A is greater than zero, - 'ANINT(A)' returns 'AINT(X+0.5)'. If A is less than or equal to - zero then it returns 'AINT(X-0.5)'. - -_Example_: - program test_anint - real(4) x4 - real(8) x8 - x4 = 1.234E0_4 - x8 = 4.321_8 - print *, anint(x4), dnint(x8) - x8 = anint(x4,8) - end program test_anint - -_Specific names_: - Name Argument Return type Standard - 'AINT(A)' 'REAL(4) A' 'REAL(4)' Fortran 77 and - later - 'DNINT(A)' 'REAL(8) A' 'REAL(8)' Fortran 77 and - later - - -File: gfortran.info, Node: ANY, Next: ASIN, Prev: ANINT, Up: Intrinsic Procedures - -8.17 'ANY' -- Any value in MASK along DIM is true -================================================= - -_Description_: - 'ANY(MASK [, DIM])' determines if any of the values in the logical - array MASK along dimension DIM are '.TRUE.'. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = ANY(MASK [, DIM])' - -_Arguments_: - MASK The type of the argument shall be 'LOGICAL' and - it shall not be scalar. - DIM (Optional) DIM shall be a scalar integer with a - value that lies between one and the rank of - MASK. - -_Return value_: - 'ANY(MASK)' returns a scalar value of type 'LOGICAL' where the kind - type parameter is the same as the kind type parameter of MASK. If - DIM is present, then 'ANY(MASK, DIM)' returns an array with the - rank of MASK minus 1. The shape is determined from the shape of - MASK where the DIM dimension is elided. - - (A) - 'ANY(MASK)' is true if any element of MASK is true; otherwise, - it is false. It also is false if MASK has zero size. - (B) - If the rank of MASK is one, then 'ANY(MASK,DIM)' is equivalent - to 'ANY(MASK)'. If the rank is greater than one, then - 'ANY(MASK,DIM)' is determined by applying 'ANY' to the array - sections. - -_Example_: - program test_any - logical l - l = any((/.true., .true., .true./)) - print *, l - call section - contains - subroutine section - integer a(2,3), b(2,3) - a = 1 - b = 1 - b(2,2) = 2 - print *, any(a .eq. b, 1) - print *, any(a .eq. b, 2) - end subroutine section - end program test_any - - -File: gfortran.info, Node: ASIN, Next: ASINH, Prev: ANY, Up: Intrinsic Procedures - -8.18 'ASIN' -- Arcsine function -=============================== - -_Description_: - 'ASIN(X)' computes the arcsine of its X (inverse of 'SIN(X)'). - -_Standard_: - Fortran 77 and later, for a complex argument Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ASIN(X)' - -_Arguments_: - X The type shall be either 'REAL' and a magnitude - that is less than or equal to one - or be - 'COMPLEX'. - -_Return value_: - The return value is of the same type and kind as X. The real part - of the result is in radians and lies in the range -\pi/2 \leq \Re - \asin(x) \leq \pi/2. - -_Example_: - program test_asin - real(8) :: x = 0.866_8 - x = asin(x) - end program test_asin - -_Specific names_: - Name Argument Return type Standard - 'ASIN(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and - later - 'DASIN(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and - later - -_See also_: - Inverse function: *note SIN:: - - -File: gfortran.info, Node: ASINH, Next: ASSOCIATED, Prev: ASIN, Up: Intrinsic Procedures - -8.19 'ASINH' -- Inverse hyperbolic sine function -================================================ - -_Description_: - 'ASINH(X)' computes the inverse hyperbolic sine of X. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ASINH(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value is of the same type and kind as X. If X is - complex, the imaginary part of the result is in radians and lies - between -\pi/2 \leq \Im \asinh(x) \leq \pi/2. - -_Example_: - PROGRAM test_asinh - REAL(8), DIMENSION(3) :: x = (/ -1.0, 0.0, 1.0 /) - WRITE (*,*) ASINH(x) - END PROGRAM - -_Specific names_: - Name Argument Return type Standard - 'DASINH(X)' 'REAL(8) X' 'REAL(8)' GNU extension. - -_See also_: - Inverse function: *note SINH:: - - -File: gfortran.info, Node: ASSOCIATED, Next: ATAN, Prev: ASINH, Up: Intrinsic Procedures - -8.20 'ASSOCIATED' -- Status of a pointer or pointer/target pair -=============================================================== - -_Description_: - 'ASSOCIATED(POINTER [, TARGET])' determines the status of the - pointer POINTER or if POINTER is associated with the target TARGET. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = ASSOCIATED(POINTER [, TARGET])' - -_Arguments_: - POINTER POINTER shall have the 'POINTER' attribute and - it can be of any type. - TARGET (Optional) TARGET shall be a pointer or a - target. It must have the same type, kind type - parameter, and array rank as POINTER. - The association status of neither POINTER nor TARGET shall be - undefined. - -_Return value_: - 'ASSOCIATED(POINTER)' returns a scalar value of type 'LOGICAL(4)'. - There are several cases: - (A) When the optional TARGET is not present then - 'ASSOCIATED(POINTER)' is true if POINTER is associated with a - target; otherwise, it returns false. - (B) If TARGET is present and a scalar target, the result is true if - TARGET is not a zero-sized storage sequence and the target - associated with POINTER occupies the same storage units. If - POINTER is disassociated, the result is false. - (C) If TARGET is present and an array target, the result is true if - TARGET and POINTER have the same shape, are not zero-sized - arrays, are arrays whose elements are not zero-sized storage - sequences, and TARGET and POINTER occupy the same storage - units in array element order. As in case(B), the result is - false, if POINTER is disassociated. - (D) If TARGET is present and an scalar pointer, the result is true - if TARGET is associated with POINTER, the target associated - with TARGET are not zero-sized storage sequences and occupy - the same storage units. The result is false, if either TARGET - or POINTER is disassociated. - (E) If TARGET is present and an array pointer, the result is true if - target associated with POINTER and the target associated with - TARGET have the same shape, are not zero-sized arrays, are - arrays whose elements are not zero-sized storage sequences, - and TARGET and POINTER occupy the same storage units in array - element order. The result is false, if either TARGET or - POINTER is disassociated. - -_Example_: - program test_associated - implicit none - real, target :: tgt(2) = (/1., 2./) - real, pointer :: ptr(:) - ptr => tgt - if (associated(ptr) .eqv. .false.) call abort - if (associated(ptr,tgt) .eqv. .false.) call abort - end program test_associated - -_See also_: - *note NULL:: - - -File: gfortran.info, Node: ATAN, Next: ATAN2, Prev: ASSOCIATED, Up: Intrinsic Procedures - -8.21 'ATAN' -- Arctangent function -================================== - -_Description_: - 'ATAN(X)' computes the arctangent of X. - -_Standard_: - Fortran 77 and later, for a complex argument and for two arguments - Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ATAN(X)' - 'RESULT = ATAN(Y, X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'; if Y is - present, X shall be REAL. - Y shall - be of the - same type - and kind - as X. - -_Return value_: - The return value is of the same type and kind as X. If Y is - present, the result is identical to 'ATAN2(Y,X)'. Otherwise, it - the arcus tangent of X, where the real part of the result is in - radians and lies in the range -\pi/2 \leq \Re \atan(x) \leq \pi/2. - -_Example_: - program test_atan - real(8) :: x = 2.866_8 - x = atan(x) - end program test_atan - -_Specific names_: - Name Argument Return type Standard - 'ATAN(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and - later - 'DATAN(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and - later - -_See also_: - Inverse function: *note TAN:: - - -File: gfortran.info, Node: ATAN2, Next: ATANH, Prev: ATAN, Up: Intrinsic Procedures - -8.22 'ATAN2' -- Arctangent function -=================================== - -_Description_: - 'ATAN2(Y, X)' computes the principal value of the argument function - of the complex number X + i Y. This function can be used to - transform from Cartesian into polar coordinates and allows to - determine the angle in the correct quadrant. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ATAN2(Y, X)' - -_Arguments_: - Y The type shall be 'REAL'. - X The type and kind type parameter shall be the - same as Y. If Y is zero, then X must be - nonzero. - -_Return value_: - The return value has the same type and kind type parameter as Y. - It is the principal value of the complex number X + i Y. If X is - nonzero, then it lies in the range -\pi \le \atan (x) \leq \pi. - The sign is positive if Y is positive. If Y is zero, then the - return value is zero if X is strictly positive, \pi if X is - negative and Y is positive zero (or the processor does not handle - signed zeros), and -\pi if X is negative and Y is negative zero. - Finally, if X is zero, then the magnitude of the result is \pi/2. - -_Example_: - program test_atan2 - real(4) :: x = 1.e0_4, y = 0.5e0_4 - x = atan2(y,x) - end program test_atan2 - -_Specific names_: - Name Argument Return type Standard - 'ATAN2(X, 'REAL(4) X, 'REAL(4)' Fortran 77 and - Y)' Y' later - 'DATAN2(X, 'REAL(8) X, 'REAL(8)' Fortran 77 and - Y)' Y' later - - -File: gfortran.info, Node: ATANH, Next: ATOMIC_DEFINE, Prev: ATAN2, Up: Intrinsic Procedures - -8.23 'ATANH' -- Inverse hyperbolic tangent function -=================================================== - -_Description_: - 'ATANH(X)' computes the inverse hyperbolic tangent of X. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ATANH(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. If X is complex, the - imaginary part of the result is in radians and lies between -\pi/2 - \leq \Im \atanh(x) \leq \pi/2. - -_Example_: - PROGRAM test_atanh - REAL, DIMENSION(3) :: x = (/ -1.0, 0.0, 1.0 /) - WRITE (*,*) ATANH(x) - END PROGRAM - -_Specific names_: - Name Argument Return type Standard - 'DATANH(X)' 'REAL(8) X' 'REAL(8)' GNU extension - -_See also_: - Inverse function: *note TANH:: - - -File: gfortran.info, Node: ATOMIC_DEFINE, Next: ATOMIC_REF, Prev: ATANH, Up: Intrinsic Procedures - -8.24 'ATOMIC_DEFINE' -- Setting a variable atomically -===================================================== - -_Description_: - 'ATOMIC_DEFINE(ATOM, VALUE)' defines the variable ATOM with the - value VALUE atomically. - -_Standard_: - Fortran 2008 and later - -_Class_: - Atomic subroutine - -_Syntax_: - 'CALL ATOMIC_DEFINE(ATOM, VALUE)' - -_Arguments_: - ATOM Scalar coarray or coindexed variable of either - integer type with 'ATOMIC_INT_KIND' kind or - logical type with 'ATOMIC_LOGICAL_KIND' kind. - VALURE Scalar and of the same type as ATOM. If the - kind is different, the value is converted to the - kind of ATOM. - -_Example_: - program atomic - use iso_fortran_env - integer(atomic_int_kind) :: atom[*] - call atomic_define (atom[1], this_image()) - end program atomic - -_See also_: - *note ATOMIC_REF::, *note ISO_FORTRAN_ENV:: - - -File: gfortran.info, Node: ATOMIC_REF, Next: BACKTRACE, Prev: ATOMIC_DEFINE, Up: Intrinsic Procedures - -8.25 'ATOMIC_REF' -- Obtaining the value of a variable atomically -================================================================= - -_Description_: - 'ATOMIC_DEFINE(ATOM, VALUE)' atomically assigns the value of the - variable ATOM to VALUE. - -_Standard_: - Fortran 2008 and later - -_Class_: - Atomic subroutine - -_Syntax_: - 'CALL ATOMIC_REF(VALUE, ATOM)' - -_Arguments_: - VALURE Scalar and of the same type as ATOM. If the - kind is different, the value is converted to the - kind of ATOM. - ATOM Scalar coarray or coindexed variable of either - integer type with 'ATOMIC_INT_KIND' kind or - logical type with 'ATOMIC_LOGICAL_KIND' kind. - -_Example_: - program atomic - use iso_fortran_env - logical(atomic_logical_kind) :: atom[*] - logical :: val - call atomic_ref (atom, .false.) - ! ... - call atomic_ref (atom, val) - if (val) then - print *, "Obtained" - end if - end program atomic - -_See also_: - *note ATOMIC_DEFINE::, *note ISO_FORTRAN_ENV:: - - -File: gfortran.info, Node: BACKTRACE, Next: BESSEL_J0, Prev: ATOMIC_REF, Up: Intrinsic Procedures - -8.26 'BACKTRACE' -- Show a backtrace -==================================== - -_Description_: - 'BACKTRACE' shows a backtrace at an arbitrary place in user code. - Program execution continues normally afterwards. The backtrace - information is printed to the unit corresponding to 'ERROR_UNIT' in - 'ISO_FORTRAN_ENV'. - -_Standard_: - GNU Extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL BACKTRACE' - -_Arguments_: - None - -_See also_: - *note ABORT:: - - -File: gfortran.info, Node: BESSEL_J0, Next: BESSEL_J1, Prev: BACKTRACE, Up: Intrinsic Procedures - -8.27 'BESSEL_J0' -- Bessel function of the first kind of order 0 -================================================================ - -_Description_: - 'BESSEL_J0(X)' computes the Bessel function of the first kind of - order 0 of X. This function is available under the name 'BESJ0' as - a GNU extension. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BESSEL_J0(X)' - -_Arguments_: - X The type shall be 'REAL', and it shall be - scalar. - -_Return value_: - The return value is of type 'REAL' and lies in the range - - 0.4027... \leq Bessel (0,x) \leq 1. It has the same kind as X. - -_Example_: - program test_besj0 - real(8) :: x = 0.0_8 - x = bessel_j0(x) - end program test_besj0 - -_Specific names_: - Name Argument Return type Standard - 'DBESJ0(X)' 'REAL(8) X' 'REAL(8)' GNU extension - - -File: gfortran.info, Node: BESSEL_J1, Next: BESSEL_JN, Prev: BESSEL_J0, Up: Intrinsic Procedures - -8.28 'BESSEL_J1' -- Bessel function of the first kind of order 1 -================================================================ - -_Description_: - 'BESSEL_J1(X)' computes the Bessel function of the first kind of - order 1 of X. This function is available under the name 'BESJ1' as - a GNU extension. - -_Standard_: - Fortran 2008 - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BESSEL_J1(X)' - -_Arguments_: - X The type shall be 'REAL', and it shall be - scalar. - -_Return value_: - The return value is of type 'REAL' and it lies in the range - - 0.5818... \leq Bessel (0,x) \leq 0.5818 . It has the same kind as - X. - -_Example_: - program test_besj1 - real(8) :: x = 1.0_8 - x = bessel_j1(x) - end program test_besj1 - -_Specific names_: - Name Argument Return type Standard - 'DBESJ1(X)' 'REAL(8) X' 'REAL(8)' GNU extension - - -File: gfortran.info, Node: BESSEL_JN, Next: BESSEL_Y0, Prev: BESSEL_J1, Up: Intrinsic Procedures - -8.29 'BESSEL_JN' -- Bessel function of the first kind -===================================================== - -_Description_: - 'BESSEL_JN(N, X)' computes the Bessel function of the first kind of - order N of X. This function is available under the name 'BESJN' as - a GNU extension. If N and X are arrays, their ranks and shapes - shall conform. - - 'BESSEL_JN(N1, N2, X)' returns an array with the Bessel functions - of the first kind of the orders N1 to N2. - -_Standard_: - Fortran 2008 and later, negative N is allowed as GNU extension - -_Class_: - Elemental function, except for the transformational function - 'BESSEL_JN(N1, N2, X)' - -_Syntax_: - 'RESULT = BESSEL_JN(N, X)' - 'RESULT = BESSEL_JN(N1, N2, X)' - -_Arguments_: - N Shall be a scalar or an array of type 'INTEGER'. - N1 Shall be a non-negative scalar of type - 'INTEGER'. - N2 Shall be a non-negative scalar of type - 'INTEGER'. - X Shall be a scalar or an array of type 'REAL'; - for 'BESSEL_JN(N1, N2, X)' it shall be scalar. - -_Return value_: - The return value is a scalar of type 'REAL'. It has the same kind - as X. - -_Note_: - The transformational function uses a recurrence algorithm which - might, for some values of X, lead to different results than calls - to the elemental function. - -_Example_: - program test_besjn - real(8) :: x = 1.0_8 - x = bessel_jn(5,x) - end program test_besjn - -_Specific names_: - Name Argument Return type Standard - 'DBESJN(N, 'INTEGER N' 'REAL(8)' GNU extension - X)' - 'REAL(8) X' - - -File: gfortran.info, Node: BESSEL_Y0, Next: BESSEL_Y1, Prev: BESSEL_JN, Up: Intrinsic Procedures - -8.30 'BESSEL_Y0' -- Bessel function of the second kind of order 0 -================================================================= - -_Description_: - 'BESSEL_Y0(X)' computes the Bessel function of the second kind of - order 0 of X. This function is available under the name 'BESY0' as - a GNU extension. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BESSEL_Y0(X)' - -_Arguments_: - X The type shall be 'REAL', and it shall be - scalar. - -_Return value_: - The return value is a scalar of type 'REAL'. It has the same kind - as X. - -_Example_: - program test_besy0 - real(8) :: x = 0.0_8 - x = bessel_y0(x) - end program test_besy0 - -_Specific names_: - Name Argument Return type Standard - 'DBESY0(X)' 'REAL(8) X' 'REAL(8)' GNU extension - - -File: gfortran.info, Node: BESSEL_Y1, Next: BESSEL_YN, Prev: BESSEL_Y0, Up: Intrinsic Procedures - -8.31 'BESSEL_Y1' -- Bessel function of the second kind of order 1 -================================================================= - -_Description_: - 'BESSEL_Y1(X)' computes the Bessel function of the second kind of - order 1 of X. This function is available under the name 'BESY1' as - a GNU extension. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BESSEL_Y1(X)' - -_Arguments_: - X The type shall be 'REAL', and it shall be - scalar. - -_Return value_: - The return value is a scalar of type 'REAL'. It has the same kind - as X. - -_Example_: - program test_besy1 - real(8) :: x = 1.0_8 - x = bessel_y1(x) - end program test_besy1 - -_Specific names_: - Name Argument Return type Standard - 'DBESY1(X)' 'REAL(8) X' 'REAL(8)' GNU extension - - -File: gfortran.info, Node: BESSEL_YN, Next: BGE, Prev: BESSEL_Y1, Up: Intrinsic Procedures - -8.32 'BESSEL_YN' -- Bessel function of the second kind -====================================================== - -_Description_: - 'BESSEL_YN(N, X)' computes the Bessel function of the second kind - of order N of X. This function is available under the name 'BESYN' - as a GNU extension. If N and X are arrays, their ranks and shapes - shall conform. - - 'BESSEL_YN(N1, N2, X)' returns an array with the Bessel functions - of the first kind of the orders N1 to N2. - -_Standard_: - Fortran 2008 and later, negative N is allowed as GNU extension - -_Class_: - Elemental function, except for the transformational function - 'BESSEL_YN(N1, N2, X)' - -_Syntax_: - 'RESULT = BESSEL_YN(N, X)' - 'RESULT = BESSEL_YN(N1, N2, X)' - -_Arguments_: - N Shall be a scalar or an array of type 'INTEGER' - . - N1 Shall be a non-negative scalar of type - 'INTEGER'. - N2 Shall be a non-negative scalar of type - 'INTEGER'. - X Shall be a scalar or an array of type 'REAL'; - for 'BESSEL_YN(N1, N2, X)' it shall be scalar. - -_Return value_: - The return value is a scalar of type 'REAL'. It has the same kind - as X. - -_Note_: - The transformational function uses a recurrence algorithm which - might, for some values of X, lead to different results than calls - to the elemental function. - -_Example_: - program test_besyn - real(8) :: x = 1.0_8 - x = bessel_yn(5,x) - end program test_besyn - -_Specific names_: - Name Argument Return type Standard - 'DBESYN(N,X)' 'INTEGER N' 'REAL(8)' GNU extension - 'REAL(8) X' - - -File: gfortran.info, Node: BGE, Next: BGT, Prev: BESSEL_YN, Up: Intrinsic Procedures - -8.33 'BGE' -- Bitwise greater than or equal to -============================================== - -_Description_: - Determines whether an integral is a bitwise greater than or equal - to another. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BGE(I, J)' - -_Arguments_: - I Shall be of 'INTEGER' type. - J Shall be of 'INTEGER' type, and of the same kind - as I. - -_Return value_: - The return value is of type 'LOGICAL' and of the default kind. - -_See also_: - *note BGT::, *note BLE::, *note BLT:: - - -File: gfortran.info, Node: BGT, Next: BIT_SIZE, Prev: BGE, Up: Intrinsic Procedures - -8.34 'BGT' -- Bitwise greater than -================================== - -_Description_: - Determines whether an integral is a bitwise greater than another. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BGT(I, J)' - -_Arguments_: - I Shall be of 'INTEGER' type. - J Shall be of 'INTEGER' type, and of the same kind - as I. - -_Return value_: - The return value is of type 'LOGICAL' and of the default kind. - -_See also_: - *note BGE::, *note BLE::, *note BLT:: - - -File: gfortran.info, Node: BIT_SIZE, Next: BLE, Prev: BGT, Up: Intrinsic Procedures - -8.35 'BIT_SIZE' -- Bit size inquiry function -============================================ - -_Description_: - 'BIT_SIZE(I)' returns the number of bits (integer precision plus - sign bit) represented by the type of I. The result of - 'BIT_SIZE(I)' is independent of the actual value of I. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = BIT_SIZE(I)' - -_Arguments_: - I The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' - -_Example_: - program test_bit_size - integer :: i = 123 - integer :: size - size = bit_size(i) - print *, size - end program test_bit_size - - -File: gfortran.info, Node: BLE, Next: BLT, Prev: BIT_SIZE, Up: Intrinsic Procedures - -8.36 'BLE' -- Bitwise less than or equal to -=========================================== - -_Description_: - Determines whether an integral is a bitwise less than or equal to - another. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BLE(I, J)' - -_Arguments_: - I Shall be of 'INTEGER' type. - J Shall be of 'INTEGER' type, and of the same kind - as I. - -_Return value_: - The return value is of type 'LOGICAL' and of the default kind. - -_See also_: - *note BGT::, *note BGE::, *note BLT:: - - -File: gfortran.info, Node: BLT, Next: BTEST, Prev: BLE, Up: Intrinsic Procedures - -8.37 'BLT' -- Bitwise less than -=============================== - -_Description_: - Determines whether an integral is a bitwise less than another. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BLT(I, J)' - -_Arguments_: - I Shall be of 'INTEGER' type. - J Shall be of 'INTEGER' type, and of the same kind - as I. - -_Return value_: - The return value is of type 'LOGICAL' and of the default kind. - -_See also_: - *note BGE::, *note BGT::, *note BLE:: - - -File: gfortran.info, Node: BTEST, Next: C_ASSOCIATED, Prev: BLT, Up: Intrinsic Procedures - -8.38 'BTEST' -- Bit test function -================================= - -_Description_: - 'BTEST(I,POS)' returns logical '.TRUE.' if the bit at POS in I is - set. The counting of the bits starts at 0. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = BTEST(I, POS)' - -_Arguments_: - I The type shall be 'INTEGER'. - POS The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'LOGICAL' - -_Example_: - program test_btest - integer :: i = 32768 + 1024 + 64 - integer :: pos - logical :: bool - do pos=0,16 - bool = btest(i, pos) - print *, pos, bool - end do - end program test_btest - - -File: gfortran.info, Node: C_ASSOCIATED, Next: C_F_POINTER, Prev: BTEST, Up: Intrinsic Procedures - -8.39 'C_ASSOCIATED' -- Status of a C pointer -============================================ - -_Description_: - 'C_ASSOCIATED(c_prt_1[, c_ptr_2])' determines the status of the C - pointer C_PTR_1 or if C_PTR_1 is associated with the target - C_PTR_2. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = C_ASSOCIATED(c_prt_1[, c_ptr_2])' - -_Arguments_: - C_PTR_1 Scalar of the type 'C_PTR' or 'C_FUNPTR'. - C_PTR_2 (Optional) Scalar of the same type as C_PTR_1. - -_Return value_: - The return value is of type 'LOGICAL'; it is '.false.' if either - C_PTR_1 is a C NULL pointer or if C_PTR1 and C_PTR_2 point to - different addresses. - -_Example_: - subroutine association_test(a,b) - use iso_c_binding, only: c_associated, c_loc, c_ptr - implicit none - real, pointer :: a - type(c_ptr) :: b - if(c_associated(b, c_loc(a))) & - stop 'b and a do not point to same target' - end subroutine association_test - -_See also_: - *note C_LOC::, *note C_FUNLOC:: - - -File: gfortran.info, Node: C_F_POINTER, Next: C_F_PROCPOINTER, Prev: C_ASSOCIATED, Up: Intrinsic Procedures - -8.40 'C_F_POINTER' -- Convert C into Fortran pointer -==================================================== - -_Description_: - 'C_F_POINTER(CPTR, FPTR[, SHAPE])' assigns the target of the C - pointer CPTR to the Fortran pointer FPTR and specifies its shape. - -_Standard_: - Fortran 2003 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL C_F_POINTER(CPTR, FPTR[, SHAPE])' - -_Arguments_: - CPTR scalar of the type 'C_PTR'. It is 'INTENT(IN)'. - FPTR pointer interoperable with CPTR. It is - 'INTENT(OUT)'. - SHAPE (Optional) Rank-one array of type 'INTEGER' with - 'INTENT(IN)'. It shall be present if and only - if FPTR is an array. The size must be equal to - the rank of FPTR. - -_Example_: - program main - use iso_c_binding - implicit none - interface - subroutine my_routine(p) bind(c,name='myC_func') - import :: c_ptr - type(c_ptr), intent(out) :: p - end subroutine - end interface - type(c_ptr) :: cptr - real,pointer :: a(:) - call my_routine(cptr) - call c_f_pointer(cptr, a, [12]) - end program main - -_See also_: - *note C_LOC::, *note C_F_PROCPOINTER:: - - -File: gfortran.info, Node: C_F_PROCPOINTER, Next: C_FUNLOC, Prev: C_F_POINTER, Up: Intrinsic Procedures - -8.41 'C_F_PROCPOINTER' -- Convert C into Fortran procedure pointer -================================================================== - -_Description_: - 'C_F_PROCPOINTER(CPTR, FPTR)' Assign the target of the C function - pointer CPTR to the Fortran procedure pointer FPTR. - -_Standard_: - Fortran 2003 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL C_F_PROCPOINTER(cptr, fptr)' - -_Arguments_: - CPTR scalar of the type 'C_FUNPTR'. It is - 'INTENT(IN)'. - FPTR procedure pointer interoperable with CPTR. It - is 'INTENT(OUT)'. - -_Example_: - program main - use iso_c_binding - implicit none - abstract interface - function func(a) - import :: c_float - real(c_float), intent(in) :: a - real(c_float) :: func - end function - end interface - interface - function getIterFunc() bind(c,name="getIterFunc") - import :: c_funptr - type(c_funptr) :: getIterFunc - end function - end interface - type(c_funptr) :: cfunptr - procedure(func), pointer :: myFunc - cfunptr = getIterFunc() - call c_f_procpointer(cfunptr, myFunc) - end program main - -_See also_: - *note C_LOC::, *note C_F_POINTER:: - - -File: gfortran.info, Node: C_FUNLOC, Next: C_LOC, Prev: C_F_PROCPOINTER, Up: Intrinsic Procedures - -8.42 'C_FUNLOC' -- Obtain the C address of a procedure -====================================================== - -_Description_: - 'C_FUNLOC(x)' determines the C address of the argument. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = C_FUNLOC(x)' - -_Arguments_: - X Interoperable function or pointer to such - function. - -_Return value_: - The return value is of type 'C_FUNPTR' and contains the C address - of the argument. - -_Example_: - module x - use iso_c_binding - implicit none - contains - subroutine sub(a) bind(c) - real(c_float) :: a - a = sqrt(a)+5.0 - end subroutine sub - end module x - program main - use iso_c_binding - use x - implicit none - interface - subroutine my_routine(p) bind(c,name='myC_func') - import :: c_funptr - type(c_funptr), intent(in) :: p - end subroutine - end interface - call my_routine(c_funloc(sub)) - end program main - -_See also_: - *note C_ASSOCIATED::, *note C_LOC::, *note C_F_POINTER::, *note - C_F_PROCPOINTER:: - - -File: gfortran.info, Node: C_LOC, Next: C_SIZEOF, Prev: C_FUNLOC, Up: Intrinsic Procedures - -8.43 'C_LOC' -- Obtain the C address of an object -================================================= - -_Description_: - 'C_LOC(X)' determines the C address of the argument. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = C_LOC(X)' - -_Arguments_: - X Shall have either the POINTER or TARGET attribute. - It shall not be a coindexed object. It shall either - be a variable with interoperable type and kind type - parameters, or be a scalar, nonpolymorphic variable - with no length type parameters. - - -_Return value_: - The return value is of type 'C_PTR' and contains the C address of - the argument. - -_Example_: - subroutine association_test(a,b) - use iso_c_binding, only: c_associated, c_loc, c_ptr - implicit none - real, pointer :: a - type(c_ptr) :: b - if(c_associated(b, c_loc(a))) & - stop 'b and a do not point to same target' - end subroutine association_test - -_See also_: - *note C_ASSOCIATED::, *note C_FUNLOC::, *note C_F_POINTER::, *note - C_F_PROCPOINTER:: - - -File: gfortran.info, Node: C_SIZEOF, Next: CEILING, Prev: C_LOC, Up: Intrinsic Procedures - -8.44 'C_SIZEOF' -- Size in bytes of an expression -================================================= - -_Description_: - 'C_SIZEOF(X)' calculates the number of bytes of storage the - expression 'X' occupies. - -_Standard_: - Fortran 2008 - -_Class_: - Inquiry function of the module 'ISO_C_BINDING' - -_Syntax_: - 'N = C_SIZEOF(X)' - -_Arguments_: - X The argument shall be an interoperable data - entity. - -_Return value_: - The return value is of type integer and of the system-dependent - kind 'C_SIZE_T' (from the 'ISO_C_BINDING' module). Its value is - the number of bytes occupied by the argument. If the argument has - the 'POINTER' attribute, the number of bytes of the storage area - pointed to is returned. If the argument is of a derived type with - 'POINTER' or 'ALLOCATABLE' components, the return value does not - account for the sizes of the data pointed to by these components. - -_Example_: - use iso_c_binding - integer(c_int) :: i - real(c_float) :: r, s(5) - print *, (c_sizeof(s)/c_sizeof(r) == 5) - end - The example will print '.TRUE.' unless you are using a platform - where default 'REAL' variables are unusually padded. - -_See also_: - *note SIZEOF::, *note STORAGE_SIZE:: - - -File: gfortran.info, Node: CEILING, Next: CHAR, Prev: C_SIZEOF, Up: Intrinsic Procedures - -8.45 'CEILING' -- Integer ceiling function -========================================== - -_Description_: - 'CEILING(A)' returns the least integer greater than or equal to A. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = CEILING(A [, KIND])' - -_Arguments_: - A The type shall be 'REAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER(KIND)' if KIND is present and - a default-kind 'INTEGER' otherwise. - -_Example_: - program test_ceiling - real :: x = 63.29 - real :: y = -63.59 - print *, ceiling(x) ! returns 64 - print *, ceiling(y) ! returns -63 - end program test_ceiling - -_See also_: - *note FLOOR::, *note NINT:: - - -File: gfortran.info, Node: CHAR, Next: CHDIR, Prev: CEILING, Up: Intrinsic Procedures - -8.46 'CHAR' -- Character conversion function -============================================ - -_Description_: - 'CHAR(I [, KIND])' returns the character represented by the integer - I. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = CHAR(I [, KIND])' - -_Arguments_: - I The type shall be 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'CHARACTER(1)' - -_Example_: - program test_char - integer :: i = 74 - character(1) :: c - c = char(i) - print *, i, c ! returns 'J' - end program test_char - -_Specific names_: - Name Argument Return type Standard - 'CHAR(I)' 'INTEGER I' 'CHARACTER(LEN=1)'F77 and later - -_Note_: - See *note ICHAR:: for a discussion of converting between numerical - values and formatted string representations. - -_See also_: - *note ACHAR::, *note IACHAR::, *note ICHAR:: - - -File: gfortran.info, Node: CHDIR, Next: CHMOD, Prev: CHAR, Up: Intrinsic Procedures - -8.47 'CHDIR' -- Change working directory -======================================== - -_Description_: - Change current working directory to a specified path. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL CHDIR(NAME [, STATUS])' - 'STATUS = CHDIR(NAME)' - -_Arguments_: - NAME The type shall be 'CHARACTER' of default kind - and shall specify a valid path within the file - system. - STATUS (Optional) 'INTEGER' status flag of the default - kind. Returns 0 on success, and a system - specific and nonzero error code otherwise. - -_Example_: - PROGRAM test_chdir - CHARACTER(len=255) :: path - CALL getcwd(path) - WRITE(*,*) TRIM(path) - CALL chdir("/tmp") - CALL getcwd(path) - WRITE(*,*) TRIM(path) - END PROGRAM - -_See also_: - *note GETCWD:: - - -File: gfortran.info, Node: CHMOD, Next: CMPLX, Prev: CHDIR, Up: Intrinsic Procedures - -8.48 'CHMOD' -- Change access permissions of files -================================================== - -_Description_: - 'CHMOD' changes the permissions of a file. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL CHMOD(NAME, MODE[, STATUS])' - 'STATUS = CHMOD(NAME, MODE)' - -_Arguments_: - - NAME Scalar 'CHARACTER' of default kind with the file - name. Trailing blanks are ignored unless the - character 'achar(0)' is present, then all - characters up to and excluding 'achar(0)' are - used as the file name. - - MODE Scalar 'CHARACTER' of default kind giving the - file permission. MODE uses the same syntax as - the 'chmod' utility as defined by the POSIX - standard. The argument shall either be a string - of a nonnegative octal number or a symbolic - mode. - - STATUS (optional) scalar 'INTEGER', which is '0' on - success and nonzero otherwise. - -_Return value_: - In either syntax, STATUS is set to '0' on success and nonzero - otherwise. - -_Example_: - 'CHMOD' as subroutine - program chmod_test - implicit none - integer :: status - call chmod('test.dat','u+x',status) - print *, 'Status: ', status - end program chmod_test - 'CHMOD' as function: - program chmod_test - implicit none - integer :: status - status = chmod('test.dat','u+x') - print *, 'Status: ', status - end program chmod_test - - -File: gfortran.info, Node: CMPLX, Next: COMMAND_ARGUMENT_COUNT, Prev: CHMOD, Up: Intrinsic Procedures - -8.49 'CMPLX' -- Complex conversion function -=========================================== - -_Description_: - 'CMPLX(X [, Y [, KIND]])' returns a complex number where X is - converted to the real component. If Y is present it is converted - to the imaginary component. If Y is not present then the imaginary - component is set to 0.0. If X is complex then Y must not be - present. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = CMPLX(X [, Y [, KIND]])' - -_Arguments_: - X The type may be 'INTEGER', 'REAL', or 'COMPLEX'. - Y (Optional; only allowed if X is not 'COMPLEX'.) - May be 'INTEGER' or 'REAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of 'COMPLEX' type, with a kind equal to KIND if - it is specified. If KIND is not specified, the result is of the - default 'COMPLEX' kind, regardless of the kinds of X and Y. - -_Example_: - program test_cmplx - integer :: i = 42 - real :: x = 3.14 - complex :: z - z = cmplx(i, x) - print *, z, cmplx(x) - end program test_cmplx - -_See also_: - *note COMPLEX:: - - -File: gfortran.info, Node: COMMAND_ARGUMENT_COUNT, Next: COMPILER_OPTIONS, Prev: CMPLX, Up: Intrinsic Procedures - -8.50 'COMMAND_ARGUMENT_COUNT' -- Get number of command line arguments -===================================================================== - -_Description_: - 'COMMAND_ARGUMENT_COUNT' returns the number of arguments passed on - the command line when the containing program was invoked. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = COMMAND_ARGUMENT_COUNT()' - -_Arguments_: - None - -_Return value_: - The return value is an 'INTEGER' of default kind. - -_Example_: - program test_command_argument_count - integer :: count - count = command_argument_count() - print *, count - end program test_command_argument_count - -_See also_: - *note GET_COMMAND::, *note GET_COMMAND_ARGUMENT:: - - -File: gfortran.info, Node: COMPILER_OPTIONS, Next: COMPILER_VERSION, Prev: COMMAND_ARGUMENT_COUNT, Up: Intrinsic Procedures - -8.51 'COMPILER_OPTIONS' -- Options passed to the compiler -========================================================= - -_Description_: - 'COMPILER_OPTIONS' returns a string with the options used for - compiling. - -_Standard_: - Fortran 2008 - -_Class_: - Inquiry function of the module 'ISO_FORTRAN_ENV' - -_Syntax_: - 'STR = COMPILER_OPTIONS()' - -_Arguments_: - None. - -_Return value_: - The return value is a default-kind string with system-dependent - length. It contains the compiler flags used to compile the file, - which called the 'COMPILER_OPTIONS' intrinsic. - -_Example_: - use iso_fortran_env - print '(4a)', 'This file was compiled by ', & - compiler_version(), ' using the options ', & - compiler_options() - end - -_See also_: - *note COMPILER_VERSION::, *note ISO_FORTRAN_ENV:: - - -File: gfortran.info, Node: COMPILER_VERSION, Next: COMPLEX, Prev: COMPILER_OPTIONS, Up: Intrinsic Procedures - -8.52 'COMPILER_VERSION' -- Compiler version string -================================================== - -_Description_: - 'COMPILER_VERSION' returns a string with the name and the version - of the compiler. - -_Standard_: - Fortran 2008 - -_Class_: - Inquiry function of the module 'ISO_FORTRAN_ENV' - -_Syntax_: - 'STR = COMPILER_VERSION()' - -_Arguments_: - None. - -_Return value_: - The return value is a default-kind string with system-dependent - length. It contains the name of the compiler and its version - number. - -_Example_: - use iso_fortran_env - print '(4a)', 'This file was compiled by ', & - compiler_version(), ' using the options ', & - compiler_options() - end - -_See also_: - *note COMPILER_OPTIONS::, *note ISO_FORTRAN_ENV:: - - -File: gfortran.info, Node: COMPLEX, Next: CONJG, Prev: COMPILER_VERSION, Up: Intrinsic Procedures - -8.53 'COMPLEX' -- Complex conversion function -============================================= - -_Description_: - 'COMPLEX(X, Y)' returns a complex number where X is converted to - the real component and Y is converted to the imaginary component. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = COMPLEX(X, Y)' - -_Arguments_: - X The type may be 'INTEGER' or 'REAL'. - Y The type may be 'INTEGER' or 'REAL'. - -_Return value_: - If X and Y are both of 'INTEGER' type, then the return value is of - default 'COMPLEX' type. - - If X and Y are of 'REAL' type, or one is of 'REAL' type and one is - of 'INTEGER' type, then the return value is of 'COMPLEX' type with - a kind equal to that of the 'REAL' argument with the highest - precision. - -_Example_: - program test_complex - integer :: i = 42 - real :: x = 3.14 - print *, complex(i, x) - end program test_complex - -_See also_: - *note CMPLX:: - - -File: gfortran.info, Node: CONJG, Next: COS, Prev: COMPLEX, Up: Intrinsic Procedures - -8.54 'CONJG' -- Complex conjugate function -========================================== - -_Description_: - 'CONJG(Z)' returns the conjugate of Z. If Z is '(x, y)' then the - result is '(x, -y)' - -_Standard_: - Fortran 77 and later, has overloads that are GNU extensions - -_Class_: - Elemental function - -_Syntax_: - 'Z = CONJG(Z)' - -_Arguments_: - Z The type shall be 'COMPLEX'. - -_Return value_: - The return value is of type 'COMPLEX'. - -_Example_: - program test_conjg - complex :: z = (2.0, 3.0) - complex(8) :: dz = (2.71_8, -3.14_8) - z= conjg(z) - print *, z - dz = dconjg(dz) - print *, dz - end program test_conjg - -_Specific names_: - Name Argument Return type Standard - 'CONJG(Z)' 'COMPLEX Z' 'COMPLEX' GNU extension - 'DCONJG(Z)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - Z' - - -File: gfortran.info, Node: COS, Next: COSH, Prev: CONJG, Up: Intrinsic Procedures - -8.55 'COS' -- Cosine function -============================= - -_Description_: - 'COS(X)' computes the cosine of X. - -_Standard_: - Fortran 77 and later, has overloads that are GNU extensions - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = COS(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value is of the same type and kind as X. The real part - of the result is in radians. If X is of the type 'REAL', the - return value lies in the range -1 \leq \cos (x) \leq 1. - -_Example_: - program test_cos - real :: x = 0.0 - x = cos(x) - end program test_cos - -_Specific names_: - Name Argument Return type Standard - 'COS(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and - later - 'DCOS(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and - later - 'CCOS(X)' 'COMPLEX(4) 'COMPLEX(4)' Fortran 77 and - X' later - 'ZCOS(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - X' - 'CDCOS(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - X' - -_See also_: - Inverse function: *note ACOS:: - - -File: gfortran.info, Node: COSH, Next: COUNT, Prev: COS, Up: Intrinsic Procedures - -8.56 'COSH' -- Hyperbolic cosine function -========================================= - -_Description_: - 'COSH(X)' computes the hyperbolic cosine of X. - -_Standard_: - Fortran 77 and later, for a complex argument Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'X = COSH(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. If X is complex, the - imaginary part of the result is in radians. If X is 'REAL', the - return value has a lower bound of one, \cosh (x) \geq 1. - -_Example_: - program test_cosh - real(8) :: x = 1.0_8 - x = cosh(x) - end program test_cosh - -_Specific names_: - Name Argument Return type Standard - 'COSH(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and - later - 'DCOSH(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and - later - -_See also_: - Inverse function: *note ACOSH:: - - -File: gfortran.info, Node: COUNT, Next: CPU_TIME, Prev: COSH, Up: Intrinsic Procedures - -8.57 'COUNT' -- Count function -============================== - -_Description_: - - Counts the number of '.TRUE.' elements in a logical MASK, or, if - the DIM argument is supplied, counts the number of elements along - each row of the array in the DIM direction. If the array has zero - size, or all of the elements of MASK are '.FALSE.', then the result - is '0'. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = COUNT(MASK [, DIM, KIND])' - -_Arguments_: - MASK The type shall be 'LOGICAL'. - DIM (Optional) The type shall be 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. If DIM is - present, the result is an array with a rank one less than the rank - of ARRAY, and a size corresponding to the shape of ARRAY with the - DIM dimension removed. - -_Example_: - program test_count - integer, dimension(2,3) :: a, b - logical, dimension(2,3) :: mask - a = reshape( (/ 1, 2, 3, 4, 5, 6 /), (/ 2, 3 /)) - b = reshape( (/ 0, 7, 3, 4, 5, 8 /), (/ 2, 3 /)) - print '(3i3)', a(1,:) - print '(3i3)', a(2,:) - print * - print '(3i3)', b(1,:) - print '(3i3)', b(2,:) - print * - mask = a.ne.b - print '(3l3)', mask(1,:) - print '(3l3)', mask(2,:) - print * - print '(3i3)', count(mask) - print * - print '(3i3)', count(mask, 1) - print * - print '(3i3)', count(mask, 2) - end program test_count - - -File: gfortran.info, Node: CPU_TIME, Next: CSHIFT, Prev: COUNT, Up: Intrinsic Procedures - -8.58 'CPU_TIME' -- CPU elapsed time in seconds -============================================== - -_Description_: - Returns a 'REAL' value representing the elapsed CPU time in - seconds. This is useful for testing segments of code to determine - execution time. - - If a time source is available, time will be reported with - microsecond resolution. If no time source is available, TIME is - set to '-1.0'. - - Note that TIME may contain a, system dependent, arbitrary offset - and may not start with '0.0'. For 'CPU_TIME', the absolute value - is meaningless, only differences between subsequent calls to this - subroutine, as shown in the example below, should be used. - -_Standard_: - Fortran 95 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL CPU_TIME(TIME)' - -_Arguments_: - TIME The type shall be 'REAL' with 'INTENT(OUT)'. - -_Return value_: - None - -_Example_: - program test_cpu_time - real :: start, finish - call cpu_time(start) - ! put code to test here - call cpu_time(finish) - print '("Time = ",f6.3," seconds.")',finish-start - end program test_cpu_time - -_See also_: - *note SYSTEM_CLOCK::, *note DATE_AND_TIME:: - - -File: gfortran.info, Node: CSHIFT, Next: CTIME, Prev: CPU_TIME, Up: Intrinsic Procedures - -8.59 'CSHIFT' -- Circular shift elements of an array -==================================================== - -_Description_: - 'CSHIFT(ARRAY, SHIFT [, DIM])' performs a circular shift on - elements of ARRAY along the dimension of DIM. If DIM is omitted it - is taken to be '1'. DIM is a scalar of type 'INTEGER' in the range - of 1 \leq DIM \leq n) where n is the rank of ARRAY. If the rank of - ARRAY is one, then all elements of ARRAY are shifted by SHIFT - places. If rank is greater than one, then all complete rank one - sections of ARRAY along the given dimension are shifted. Elements - shifted out one end of each rank one section are shifted back in - the other end. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = CSHIFT(ARRAY, SHIFT [, DIM])' - -_Arguments_: - ARRAY Shall be an array of any type. - SHIFT The type shall be 'INTEGER'. - DIM The type shall be 'INTEGER'. - -_Return value_: - Returns an array of same type and rank as the ARRAY argument. - -_Example_: - program test_cshift - integer, dimension(3,3) :: a - a = reshape( (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), (/ 3, 3 /)) - print '(3i3)', a(1,:) - print '(3i3)', a(2,:) - print '(3i3)', a(3,:) - a = cshift(a, SHIFT=(/1, 2, -1/), DIM=2) - print * - print '(3i3)', a(1,:) - print '(3i3)', a(2,:) - print '(3i3)', a(3,:) - end program test_cshift - - -File: gfortran.info, Node: CTIME, Next: DATE_AND_TIME, Prev: CSHIFT, Up: Intrinsic Procedures - -8.60 'CTIME' -- Convert a time into a string -============================================ - -_Description_: - 'CTIME' converts a system time value, such as returned by 'TIME8', - to a string. Unless the application has called 'setlocale', the - output will be in the default locale, of length 24 and of the form - 'Sat Aug 19 18:13:14 1995'. In other locales, a longer string may - result. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL CTIME(TIME, RESULT)'. - 'RESULT = CTIME(TIME)'. - -_Arguments_: - TIME The type shall be of type 'INTEGER'. - RESULT The type shall be of type 'CHARACTER' and of - default kind. It is an 'INTENT(OUT)' argument. - If the length of this variable is too short for - the time and date string to fit completely, it - will be blank on procedure return. - -_Return value_: - The converted date and time as a string. - -_Example_: - program test_ctime - integer(8) :: i - character(len=30) :: date - i = time8() - - ! Do something, main part of the program - - call ctime(i,date) - print *, 'Program was started on ', date - end program test_ctime - -_See Also_: - *note DATE_AND_TIME::, *note GMTIME::, *note LTIME::, *note TIME::, - *note TIME8:: - - -File: gfortran.info, Node: DATE_AND_TIME, Next: DBLE, Prev: CTIME, Up: Intrinsic Procedures - -8.61 'DATE_AND_TIME' -- Date and time subroutine -================================================ - -_Description_: - 'DATE_AND_TIME(DATE, TIME, ZONE, VALUES)' gets the corresponding - date and time information from the real-time system clock. DATE is - 'INTENT(OUT)' and has form ccyymmdd. TIME is 'INTENT(OUT)' and has - form hhmmss.sss. ZONE is 'INTENT(OUT)' and has form (+-)hhmm, - representing the difference with respect to Coordinated Universal - Time (UTC). Unavailable time and date parameters return blanks. - - VALUES is 'INTENT(OUT)' and provides the following: - - 'VALUE(1)': The year - 'VALUE(2)': The month - 'VALUE(3)': The day of the month - 'VALUE(4)': Time difference with UTC in - minutes - 'VALUE(5)': The hour of the day - 'VALUE(6)': The minutes of the hour - 'VALUE(7)': The seconds of the minute - 'VALUE(8)': The milliseconds of the - second - -_Standard_: - Fortran 95 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])' - -_Arguments_: - DATE (Optional) The type shall be 'CHARACTER(LEN=8)' - or larger, and of default kind. - TIME (Optional) The type shall be 'CHARACTER(LEN=10)' - or larger, and of default kind. - ZONE (Optional) The type shall be 'CHARACTER(LEN=5)' - or larger, and of default kind. - VALUES (Optional) The type shall be 'INTEGER(8)'. - -_Return value_: - None - -_Example_: - program test_time_and_date - character(8) :: date - character(10) :: time - character(5) :: zone - integer,dimension(8) :: values - ! using keyword arguments - call date_and_time(date,time,zone,values) - call date_and_time(DATE=date,ZONE=zone) - call date_and_time(TIME=time) - call date_and_time(VALUES=values) - print '(a,2x,a,2x,a)', date, time, zone - print '(8i5)', values - end program test_time_and_date - -_See also_: - *note CPU_TIME::, *note SYSTEM_CLOCK:: - - -File: gfortran.info, Node: DBLE, Next: DCMPLX, Prev: DATE_AND_TIME, Up: Intrinsic Procedures - -8.62 'DBLE' -- Double conversion function -========================================= - -_Description_: - 'DBLE(A)' Converts A to double precision real type. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DBLE(A)' - -_Arguments_: - A The type shall be 'INTEGER', 'REAL', or - 'COMPLEX'. - -_Return value_: - The return value is of type double precision real. - -_Example_: - program test_dble - real :: x = 2.18 - integer :: i = 5 - complex :: z = (2.3,1.14) - print *, dble(x), dble(i), dble(z) - end program test_dble - -_See also_: - *note REAL:: - - -File: gfortran.info, Node: DCMPLX, Next: DIGITS, Prev: DBLE, Up: Intrinsic Procedures - -8.63 'DCMPLX' -- Double complex conversion function -=================================================== - -_Description_: - 'DCMPLX(X [,Y])' returns a double complex number where X is - converted to the real component. If Y is present it is converted - to the imaginary component. If Y is not present then the imaginary - component is set to 0.0. If X is complex then Y must not be - present. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DCMPLX(X [, Y])' - -_Arguments_: - X The type may be 'INTEGER', 'REAL', or 'COMPLEX'. - Y (Optional if X is not 'COMPLEX'.) May be - 'INTEGER' or 'REAL'. - -_Return value_: - The return value is of type 'COMPLEX(8)' - -_Example_: - program test_dcmplx - integer :: i = 42 - real :: x = 3.14 - complex :: z - z = cmplx(i, x) - print *, dcmplx(i) - print *, dcmplx(x) - print *, dcmplx(z) - print *, dcmplx(x,i) - end program test_dcmplx - - -File: gfortran.info, Node: DIGITS, Next: DIM, Prev: DCMPLX, Up: Intrinsic Procedures - -8.64 'DIGITS' -- Significant binary digits function -=================================================== - -_Description_: - 'DIGITS(X)' returns the number of significant binary digits of the - internal model representation of X. For example, on a system using - a 32-bit floating point representation, a default real number would - likely return 24. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = DIGITS(X)' - -_Arguments_: - X The type may be 'INTEGER' or 'REAL'. - -_Return value_: - The return value is of type 'INTEGER'. - -_Example_: - program test_digits - integer :: i = 12345 - real :: x = 3.143 - real(8) :: y = 2.33 - print *, digits(i) - print *, digits(x) - print *, digits(y) - end program test_digits - - -File: gfortran.info, Node: DIM, Next: DOT_PRODUCT, Prev: DIGITS, Up: Intrinsic Procedures - -8.65 'DIM' -- Positive difference -================================= - -_Description_: - 'DIM(X,Y)' returns the difference 'X-Y' if the result is positive; - otherwise returns zero. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DIM(X, Y)' - -_Arguments_: - X The type shall be 'INTEGER' or 'REAL' - Y The type shall be the same type and kind as X. - -_Return value_: - The return value is of type 'INTEGER' or 'REAL'. - -_Example_: - program test_dim - integer :: i - real(8) :: x - i = dim(4, 15) - x = dim(4.345_8, 2.111_8) - print *, i - print *, x - end program test_dim - -_Specific names_: - Name Argument Return type Standard - 'DIM(X,Y)' 'REAL(4) X, 'REAL(4)' Fortran 77 and - Y' later - 'IDIM(X,Y)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and - X, Y' later - 'DDIM(X,Y)' 'REAL(8) X, 'REAL(8)' Fortran 77 and - Y' later - - -File: gfortran.info, Node: DOT_PRODUCT, Next: DPROD, Prev: DIM, Up: Intrinsic Procedures - -8.66 'DOT_PRODUCT' -- Dot product function -========================================== - -_Description_: - 'DOT_PRODUCT(VECTOR_A, VECTOR_B)' computes the dot product - multiplication of two vectors VECTOR_A and VECTOR_B. The two - vectors may be either numeric or logical and must be arrays of rank - one and of equal size. If the vectors are 'INTEGER' or 'REAL', the - result is 'SUM(VECTOR_A*VECTOR_B)'. If the vectors are 'COMPLEX', - the result is 'SUM(CONJG(VECTOR_A)*VECTOR_B)'. If the vectors are - 'LOGICAL', the result is 'ANY(VECTOR_A .AND. VECTOR_B)'. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = DOT_PRODUCT(VECTOR_A, VECTOR_B)' - -_Arguments_: - VECTOR_A The type shall be numeric or 'LOGICAL', rank 1. - VECTOR_B The type shall be numeric if VECTOR_A is of - numeric type or 'LOGICAL' if VECTOR_A is of type - 'LOGICAL'. VECTOR_B shall be a rank-one array. - -_Return value_: - If the arguments are numeric, the return value is a scalar of - numeric type, 'INTEGER', 'REAL', or 'COMPLEX'. If the arguments - are 'LOGICAL', the return value is '.TRUE.' or '.FALSE.'. - -_Example_: - program test_dot_prod - integer, dimension(3) :: a, b - a = (/ 1, 2, 3 /) - b = (/ 4, 5, 6 /) - print '(3i3)', a - print * - print '(3i3)', b - print * - print *, dot_product(a,b) - end program test_dot_prod - - -File: gfortran.info, Node: DPROD, Next: DREAL, Prev: DOT_PRODUCT, Up: Intrinsic Procedures - -8.67 'DPROD' -- Double product function -======================================= - -_Description_: - 'DPROD(X,Y)' returns the product 'X*Y'. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DPROD(X, Y)' - -_Arguments_: - X The type shall be 'REAL'. - Y The type shall be 'REAL'. - -_Return value_: - The return value is of type 'REAL(8)'. - -_Example_: - program test_dprod - real :: x = 5.2 - real :: y = 2.3 - real(8) :: d - d = dprod(x,y) - print *, d - end program test_dprod - -_Specific names_: - Name Argument Return type Standard - 'DPROD(X,Y)' 'REAL(4) X, 'REAL(4)' Fortran 77 and - Y' later - - -File: gfortran.info, Node: DREAL, Next: DSHIFTL, Prev: DPROD, Up: Intrinsic Procedures - -8.68 'DREAL' -- Double real part function -========================================= - -_Description_: - 'DREAL(Z)' returns the real part of complex variable Z. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DREAL(A)' - -_Arguments_: - A The type shall be 'COMPLEX(8)'. - -_Return value_: - The return value is of type 'REAL(8)'. - -_Example_: - program test_dreal - complex(8) :: z = (1.3_8,7.2_8) - print *, dreal(z) - end program test_dreal - -_See also_: - *note AIMAG:: - - -File: gfortran.info, Node: DSHIFTL, Next: DSHIFTR, Prev: DREAL, Up: Intrinsic Procedures - -8.69 'DSHIFTL' -- Combined left shift -===================================== - -_Description_: - 'DSHIFTL(I, J, SHIFT)' combines bits of I and J. The rightmost - SHIFT bits of the result are the leftmost SHIFT bits of J, and the - remaining bits are the rightmost bits of I. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DSHIFTL(I, J, SHIFT)' - -_Arguments_: - I Shall be of type 'INTEGER' or a BOZ constant. - J Shall be of type 'INTEGER' or a BOZ constant. - If both I and J have integer type, then they - shall have the same kind type parameter. I and - J shall not both be BOZ constants. - SHIFT Shall be of type 'INTEGER'. It shall be - nonnegative. If I is not a BOZ constant, then - SHIFT shall be less than or equal to - 'BIT_SIZE(I)'; otherwise, SHIFT shall be less - than or equal to 'BIT_SIZE(J)'. - -_Return value_: - If either I or J is a BOZ constant, it is first converted as if by - the intrinsic function 'INT' to an integer type with the kind type - parameter of the other. - -_See also_: - *note DSHIFTR:: - - -File: gfortran.info, Node: DSHIFTR, Next: DTIME, Prev: DSHIFTL, Up: Intrinsic Procedures - -8.70 'DSHIFTR' -- Combined right shift -====================================== - -_Description_: - 'DSHIFTR(I, J, SHIFT)' combines bits of I and J. The leftmost - SHIFT bits of the result are the rightmost SHIFT bits of I, and the - remaining bits are the leftmost bits of J. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = DSHIFTR(I, J, SHIFT)' - -_Arguments_: - I Shall be of type 'INTEGER' or a BOZ constant. - J Shall be of type 'INTEGER' or a BOZ constant. - If both I and J have integer type, then they - shall have the same kind type parameter. I and - J shall not both be BOZ constants. - SHIFT Shall be of type 'INTEGER'. It shall be - nonnegative. If I is not a BOZ constant, then - SHIFT shall be less than or equal to - 'BIT_SIZE(I)'; otherwise, SHIFT shall be less - than or equal to 'BIT_SIZE(J)'. - -_Return value_: - If either I or J is a BOZ constant, it is first converted as if by - the intrinsic function 'INT' to an integer type with the kind type - parameter of the other. - -_See also_: - *note DSHIFTL:: - - -File: gfortran.info, Node: DTIME, Next: EOSHIFT, Prev: DSHIFTR, Up: Intrinsic Procedures - -8.71 'DTIME' -- Execution time subroutine (or function) -======================================================= - -_Description_: - 'DTIME(VALUES, TIME)' initially returns the number of seconds of - runtime since the start of the process's execution in TIME. VALUES - returns the user and system components of this time in 'VALUES(1)' - and 'VALUES(2)' respectively. TIME is equal to 'VALUES(1) + - VALUES(2)'. - - Subsequent invocations of 'DTIME' return values accumulated since - the previous invocation. - - On some systems, the underlying timings are represented using types - with sufficiently small limits that overflows (wrap around) are - possible, such as 32-bit types. Therefore, the values returned by - this intrinsic might be, or become, negative, or numerically less - than previous values, during a single run of the compiled program. - - Please note, that this implementation is thread safe if used within - OpenMP directives, i.e., its state will be consistent while called - from multiple threads. However, if 'DTIME' is called from multiple - threads, the result is still the time since the last invocation. - This may not give the intended results. If possible, use - 'CPU_TIME' instead. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - VALUES and TIME are 'INTENT(OUT)' and provide the following: - - 'VALUES(1)': User time in seconds. - 'VALUES(2)': System time in seconds. - 'TIME': Run time since start in - seconds. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL DTIME(VALUES, TIME)'. - 'TIME = DTIME(VALUES)', (not recommended). - -_Arguments_: - VALUES The type shall be 'REAL(4), DIMENSION(2)'. - TIME The type shall be 'REAL(4)'. - -_Return value_: - Elapsed time in seconds since the last invocation or since the - start of program execution if not called before. - -_Example_: - program test_dtime - integer(8) :: i, j - real, dimension(2) :: tarray - real :: result - call dtime(tarray, result) - print *, result - print *, tarray(1) - print *, tarray(2) - do i=1,100000000 ! Just a delay - j = i * i - i - end do - call dtime(tarray, result) - print *, result - print *, tarray(1) - print *, tarray(2) - end program test_dtime - -_See also_: - *note CPU_TIME:: - - -File: gfortran.info, Node: EOSHIFT, Next: EPSILON, Prev: DTIME, Up: Intrinsic Procedures - -8.72 'EOSHIFT' -- End-off shift elements of an array -==================================================== - -_Description_: - 'EOSHIFT(ARRAY, SHIFT[, BOUNDARY, DIM])' performs an end-off shift - on elements of ARRAY along the dimension of DIM. If DIM is omitted - it is taken to be '1'. DIM is a scalar of type 'INTEGER' in the - range of 1 \leq DIM \leq n) where n is the rank of ARRAY. If the - rank of ARRAY is one, then all elements of ARRAY are shifted by - SHIFT places. If rank is greater than one, then all complete rank - one sections of ARRAY along the given dimension are shifted. - Elements shifted out one end of each rank one section are dropped. - If BOUNDARY is present then the corresponding value of from - BOUNDARY is copied back in the other end. If BOUNDARY is not - present then the following are copied in depending on the type of - ARRAY. - - _Array _Boundary Value_ - Type_ - Numeric 0 of the type and kind of ARRAY. - Logical '.FALSE.'. - Character(LEN)LEN blanks. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = EOSHIFT(ARRAY, SHIFT [, BOUNDARY, DIM])' - -_Arguments_: - ARRAY May be any type, not scalar. - SHIFT The type shall be 'INTEGER'. - BOUNDARY Same type as ARRAY. - DIM The type shall be 'INTEGER'. - -_Return value_: - Returns an array of same type and rank as the ARRAY argument. - -_Example_: - program test_eoshift - integer, dimension(3,3) :: a - a = reshape( (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), (/ 3, 3 /)) - print '(3i3)', a(1,:) - print '(3i3)', a(2,:) - print '(3i3)', a(3,:) - a = EOSHIFT(a, SHIFT=(/1, 2, 1/), BOUNDARY=-5, DIM=2) - print * - print '(3i3)', a(1,:) - print '(3i3)', a(2,:) - print '(3i3)', a(3,:) - end program test_eoshift - - -File: gfortran.info, Node: EPSILON, Next: ERF, Prev: EOSHIFT, Up: Intrinsic Procedures - -8.73 'EPSILON' -- Epsilon function -================================== - -_Description_: - 'EPSILON(X)' returns the smallest number E of the same kind as X - such that 1 + E > 1. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = EPSILON(X)' - -_Arguments_: - X The type shall be 'REAL'. - -_Return value_: - The return value is of same type as the argument. - -_Example_: - program test_epsilon - real :: x = 3.143 - real(8) :: y = 2.33 - print *, EPSILON(x) - print *, EPSILON(y) - end program test_epsilon - - -File: gfortran.info, Node: ERF, Next: ERFC, Prev: EPSILON, Up: Intrinsic Procedures - -8.74 'ERF' -- Error function -============================ - -_Description_: - 'ERF(X)' computes the error function of X. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ERF(X)' - -_Arguments_: - X The type shall be 'REAL'. - -_Return value_: - The return value is of type 'REAL', of the same kind as X and lies - in the range -1 \leq erf (x) \leq 1 . - -_Example_: - program test_erf - real(8) :: x = 0.17_8 - x = erf(x) - end program test_erf - -_Specific names_: - Name Argument Return type Standard - 'DERF(X)' 'REAL(8) X' 'REAL(8)' GNU extension - - -File: gfortran.info, Node: ERFC, Next: ERFC_SCALED, Prev: ERF, Up: Intrinsic Procedures - -8.75 'ERFC' -- Error function -============================= - -_Description_: - 'ERFC(X)' computes the complementary error function of X. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ERFC(X)' - -_Arguments_: - X The type shall be 'REAL'. - -_Return value_: - The return value is of type 'REAL' and of the same kind as X. It - lies in the range 0 \leq erfc (x) \leq 2 . - -_Example_: - program test_erfc - real(8) :: x = 0.17_8 - x = erfc(x) - end program test_erfc - -_Specific names_: - Name Argument Return type Standard - 'DERFC(X)' 'REAL(8) X' 'REAL(8)' GNU extension - - -File: gfortran.info, Node: ERFC_SCALED, Next: ETIME, Prev: ERFC, Up: Intrinsic Procedures - -8.76 'ERFC_SCALED' -- Error function -==================================== - -_Description_: - 'ERFC_SCALED(X)' computes the exponentially-scaled complementary - error function of X. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ERFC_SCALED(X)' - -_Arguments_: - X The type shall be 'REAL'. - -_Return value_: - The return value is of type 'REAL' and of the same kind as X. - -_Example_: - program test_erfc_scaled - real(8) :: x = 0.17_8 - x = erfc_scaled(x) - end program test_erfc_scaled - - -File: gfortran.info, Node: ETIME, Next: EXECUTE_COMMAND_LINE, Prev: ERFC_SCALED, Up: Intrinsic Procedures - -8.77 'ETIME' -- Execution time subroutine (or function) -======================================================= - -_Description_: - 'ETIME(VALUES, TIME)' returns the number of seconds of runtime - since the start of the process's execution in TIME. VALUES returns - the user and system components of this time in 'VALUES(1)' and - 'VALUES(2)' respectively. TIME is equal to 'VALUES(1) + - VALUES(2)'. - - On some systems, the underlying timings are represented using types - with sufficiently small limits that overflows (wrap around) are - possible, such as 32-bit types. Therefore, the values returned by - this intrinsic might be, or become, negative, or numerically less - than previous values, during a single run of the compiled program. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - VALUES and TIME are 'INTENT(OUT)' and provide the following: - - 'VALUES(1)': User time in seconds. - 'VALUES(2)': System time in seconds. - 'TIME': Run time since start in seconds. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL ETIME(VALUES, TIME)'. - 'TIME = ETIME(VALUES)', (not recommended). - -_Arguments_: - VALUES The type shall be 'REAL(4), DIMENSION(2)'. - TIME The type shall be 'REAL(4)'. - -_Return value_: - Elapsed time in seconds since the start of program execution. - -_Example_: - program test_etime - integer(8) :: i, j - real, dimension(2) :: tarray - real :: result - call ETIME(tarray, result) - print *, result - print *, tarray(1) - print *, tarray(2) - do i=1,100000000 ! Just a delay - j = i * i - i - end do - call ETIME(tarray, result) - print *, result - print *, tarray(1) - print *, tarray(2) - end program test_etime - -_See also_: - *note CPU_TIME:: - - -File: gfortran.info, Node: EXECUTE_COMMAND_LINE, Next: EXIT, Prev: ETIME, Up: Intrinsic Procedures - -8.78 'EXECUTE_COMMAND_LINE' -- Execute a shell command -====================================================== - -_Description_: - 'EXECUTE_COMMAND_LINE' runs a shell command, synchronously or - asynchronously. - - The 'COMMAND' argument is passed to the shell and executed, using - the C library's 'system' call. (The shell is 'sh' on Unix systems, - and 'cmd.exe' on Windows.) If 'WAIT' is present and has the value - false, the execution of the command is asynchronous if the system - supports it; otherwise, the command is executed synchronously. - - The three last arguments allow the user to get status information. - After synchronous execution, 'EXITSTAT' contains the integer exit - code of the command, as returned by 'system'. 'CMDSTAT' is set to - zero if the command line was executed (whatever its exit status - was). 'CMDMSG' is assigned an error message if an error has - occurred. - - Note that the 'system' function need not be thread-safe. It is the - responsibility of the user to ensure that 'system' is not called - concurrently. - -_Standard_: - Fortran 2008 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, - CMDMSG ])' - -_Arguments_: - COMMAND Shall be a default 'CHARACTER' scalar. - WAIT (Optional) Shall be a default 'LOGICAL' scalar. - EXITSTAT (Optional) Shall be an 'INTEGER' of the default - kind. - CMDSTAT (Optional) Shall be an 'INTEGER' of the default - kind. - CMDMSG (Optional) Shall be an 'CHARACTER' scalar of the - default kind. - -_Example_: - program test_exec - integer :: i - - call execute_command_line ("external_prog.exe", exitstat=i) - print *, "Exit status of external_prog.exe was ", i - - call execute_command_line ("reindex_files.exe", wait=.false.) - print *, "Now reindexing files in the background" - - end program test_exec - -_Note_: - - Because this intrinsic is implemented in terms of the 'system' - function call, its behavior with respect to signaling is processor - dependent. In particular, on POSIX-compliant systems, the SIGINT - and SIGQUIT signals will be ignored, and the SIGCHLD will be - blocked. As such, if the parent process is terminated, the child - process might not be terminated alongside. - -_See also_: - *note SYSTEM:: - - -File: gfortran.info, Node: EXIT, Next: EXP, Prev: EXECUTE_COMMAND_LINE, Up: Intrinsic Procedures - -8.79 'EXIT' -- Exit the program with status. -============================================ - -_Description_: - 'EXIT' causes immediate termination of the program with status. If - status is omitted it returns the canonical _success_ for the - system. All Fortran I/O units are closed. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL EXIT([STATUS])' - -_Arguments_: - STATUS Shall be an 'INTEGER' of the default kind. - -_Return value_: - 'STATUS' is passed to the parent process on exit. - -_Example_: - program test_exit - integer :: STATUS = 0 - print *, 'This program is going to exit.' - call EXIT(STATUS) - end program test_exit - -_See also_: - *note ABORT::, *note KILL:: - - -File: gfortran.info, Node: EXP, Next: EXPONENT, Prev: EXIT, Up: Intrinsic Procedures - -8.80 'EXP' -- Exponential function -================================== - -_Description_: - 'EXP(X)' computes the base e exponential of X. - -_Standard_: - Fortran 77 and later, has overloads that are GNU extensions - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = EXP(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. - -_Example_: - program test_exp - real :: x = 1.0 - x = exp(x) - end program test_exp - -_Specific names_: - Name Argument Return type Standard - 'EXP(X)' 'REAL(4) X' 'REAL(4)' Fortran 77 and - later - 'DEXP(X)' 'REAL(8) X' 'REAL(8)' Fortran 77 and - later - 'CEXP(X)' 'COMPLEX(4) 'COMPLEX(4)' Fortran 77 and - X' later - 'ZEXP(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - X' - 'CDEXP(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - X' - - -File: gfortran.info, Node: EXPONENT, Next: EXTENDS_TYPE_OF, Prev: EXP, Up: Intrinsic Procedures - -8.81 'EXPONENT' -- Exponent function -==================================== - -_Description_: - 'EXPONENT(X)' returns the value of the exponent part of X. If X is - zero the value returned is zero. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = EXPONENT(X)' - -_Arguments_: - X The type shall be 'REAL'. - -_Return value_: - The return value is of type default 'INTEGER'. - -_Example_: - program test_exponent - real :: x = 1.0 - integer :: i - i = exponent(x) - print *, i - print *, exponent(0.0) - end program test_exponent - - -File: gfortran.info, Node: EXTENDS_TYPE_OF, Next: FDATE, Prev: EXPONENT, Up: Intrinsic Procedures - -8.82 'EXTENDS_TYPE_OF' -- Query dynamic type for extension -========================================================== - -_Description_: - Query dynamic type for extension. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = EXTENDS_TYPE_OF(A, MOLD)' - -_Arguments_: - A Shall be an object of extensible declared type - or unlimited polymorphic. - MOLD Shall be an object of extensible declared type - or unlimited polymorphic. - -_Return value_: - The return value is a scalar of type default logical. It is true - if and only if the dynamic type of A is an extension type of the - dynamic type of MOLD. - -_See also_: - *note SAME_TYPE_AS:: - - -File: gfortran.info, Node: FDATE, Next: FGET, Prev: EXTENDS_TYPE_OF, Up: Intrinsic Procedures - -8.83 'FDATE' -- Get the current time as a string -================================================ - -_Description_: - 'FDATE(DATE)' returns the current date (using the same format as - 'CTIME') in DATE. It is equivalent to 'CALL CTIME(DATE, TIME())'. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FDATE(DATE)'. - 'DATE = FDATE()'. - -_Arguments_: - DATE The type shall be of type 'CHARACTER' of the - default kind. It is an 'INTENT(OUT)' argument. - If the length of this variable is too short for - the date and time string to fit completely, it - will be blank on procedure return. - -_Return value_: - The current date and time as a string. - -_Example_: - program test_fdate - integer(8) :: i, j - character(len=30) :: date - call fdate(date) - print *, 'Program started on ', date - do i = 1, 100000000 ! Just a delay - j = i * i - i - end do - call fdate(date) - print *, 'Program ended on ', date - end program test_fdate - -_See also_: - *note DATE_AND_TIME::, *note CTIME:: - - -File: gfortran.info, Node: FGET, Next: FGETC, Prev: FDATE, Up: Intrinsic Procedures - -8.84 'FGET' -- Read a single character in stream mode from stdin -================================================================ - -_Description_: - Read a single character in stream mode from stdin by bypassing - normal formatted output. Stream I/O should not be mixed with - normal record-oriented (formatted or unformatted) I/O on the same - unit; the results are unpredictable. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - Note that the 'FGET' intrinsic is provided for backwards - compatibility with 'g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new stream - IO feature in new code for future portability. See also *note - Fortran 2003 status::. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FGET(C [, STATUS])' - 'STATUS = FGET(C)' - -_Arguments_: - C The type shall be 'CHARACTER' and of default - kind. - STATUS (Optional) status flag of type 'INTEGER'. - Returns 0 on success, -1 on end-of-file, and a - system specific positive error code otherwise. - -_Example_: - PROGRAM test_fget - INTEGER, PARAMETER :: strlen = 100 - INTEGER :: status, i = 1 - CHARACTER(len=strlen) :: str = "" - - WRITE (*,*) 'Enter text:' - DO - CALL fget(str(i:i), status) - if (status /= 0 .OR. i > strlen) exit - i = i + 1 - END DO - WRITE (*,*) TRIM(str) - END PROGRAM - -_See also_: - *note FGETC::, *note FPUT::, *note FPUTC:: - - -File: gfortran.info, Node: FGETC, Next: FLOOR, Prev: FGET, Up: Intrinsic Procedures - -8.85 'FGETC' -- Read a single character in stream mode -====================================================== - -_Description_: - Read a single character in stream mode by bypassing normal - formatted output. Stream I/O should not be mixed with normal - record-oriented (formatted or unformatted) I/O on the same unit; - the results are unpredictable. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - Note that the 'FGET' intrinsic is provided for backwards - compatibility with 'g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new stream - IO feature in new code for future portability. See also *note - Fortran 2003 status::. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FGETC(UNIT, C [, STATUS])' - 'STATUS = FGETC(UNIT, C)' - -_Arguments_: - UNIT The type shall be 'INTEGER'. - C The type shall be 'CHARACTER' and of default - kind. - STATUS (Optional) status flag of type 'INTEGER'. - Returns 0 on success, -1 on end-of-file and a - system specific positive error code otherwise. - -_Example_: - PROGRAM test_fgetc - INTEGER :: fd = 42, status - CHARACTER :: c - - OPEN(UNIT=fd, FILE="/etc/passwd", ACTION="READ", STATUS = "OLD") - DO - CALL fgetc(fd, c, status) - IF (status /= 0) EXIT - call fput(c) - END DO - CLOSE(UNIT=fd) - END PROGRAM - -_See also_: - *note FGET::, *note FPUT::, *note FPUTC:: - - -File: gfortran.info, Node: FLOOR, Next: FLUSH, Prev: FGETC, Up: Intrinsic Procedures - -8.86 'FLOOR' -- Integer floor function -====================================== - -_Description_: - 'FLOOR(A)' returns the greatest integer less than or equal to X. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = FLOOR(A [, KIND])' - -_Arguments_: - A The type shall be 'REAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER(KIND)' if KIND is present and - of default-kind 'INTEGER' otherwise. - -_Example_: - program test_floor - real :: x = 63.29 - real :: y = -63.59 - print *, floor(x) ! returns 63 - print *, floor(y) ! returns -64 - end program test_floor - -_See also_: - *note CEILING::, *note NINT:: - - -File: gfortran.info, Node: FLUSH, Next: FNUM, Prev: FLOOR, Up: Intrinsic Procedures - -8.87 'FLUSH' -- Flush I/O unit(s) -================================= - -_Description_: - Flushes Fortran unit(s) currently open for output. Without the - optional argument, all units are flushed, otherwise just the unit - specified. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL FLUSH(UNIT)' - -_Arguments_: - UNIT (Optional) The type shall be 'INTEGER'. - -_Note_: - Beginning with the Fortran 2003 standard, there is a 'FLUSH' - statement that should be preferred over the 'FLUSH' intrinsic. - - The 'FLUSH' intrinsic and the Fortran 2003 'FLUSH' statement have - identical effect: they flush the runtime library's I/O buffer so - that the data becomes visible to other processes. This does not - guarantee that the data is committed to disk. - - On POSIX systems, you can request that all data is transferred to - the storage device by calling the 'fsync' function, with the POSIX - file descriptor of the I/O unit as argument (retrieved with GNU - intrinsic 'FNUM'). The following example shows how: - - ! Declare the interface for POSIX fsync function - interface - function fsync (fd) bind(c,name="fsync") - use iso_c_binding, only: c_int - integer(c_int), value :: fd - integer(c_int) :: fsync - end function fsync - end interface - - ! Variable declaration - integer :: ret - - ! Opening unit 10 - open (10,file="foo") - - ! ... - ! Perform I/O on unit 10 - ! ... - - ! Flush and sync - flush(10) - ret = fsync(fnum(10)) - - ! Handle possible error - if (ret /= 0) stop "Error calling FSYNC" - - -File: gfortran.info, Node: FNUM, Next: FPUT, Prev: FLUSH, Up: Intrinsic Procedures - -8.88 'FNUM' -- File number function -=================================== - -_Description_: - 'FNUM(UNIT)' returns the POSIX file descriptor number corresponding - to the open Fortran I/O unit 'UNIT'. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = FNUM(UNIT)' - -_Arguments_: - UNIT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' - -_Example_: - program test_fnum - integer :: i - open (unit=10, status = "scratch") - i = fnum(10) - print *, i - close (10) - end program test_fnum - - -File: gfortran.info, Node: FPUT, Next: FPUTC, Prev: FNUM, Up: Intrinsic Procedures - -8.89 'FPUT' -- Write a single character in stream mode to stdout -================================================================ - -_Description_: - Write a single character in stream mode to stdout by bypassing - normal formatted output. Stream I/O should not be mixed with - normal record-oriented (formatted or unformatted) I/O on the same - unit; the results are unpredictable. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - Note that the 'FGET' intrinsic is provided for backwards - compatibility with 'g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new stream - IO feature in new code for future portability. See also *note - Fortran 2003 status::. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FPUT(C [, STATUS])' - 'STATUS = FPUT(C)' - -_Arguments_: - C The type shall be 'CHARACTER' and of default - kind. - STATUS (Optional) status flag of type 'INTEGER'. - Returns 0 on success, -1 on end-of-file and a - system specific positive error code otherwise. - -_Example_: - PROGRAM test_fput - CHARACTER(len=10) :: str = "gfortran" - INTEGER :: i - DO i = 1, len_trim(str) - CALL fput(str(i:i)) - END DO - END PROGRAM - -_See also_: - *note FPUTC::, *note FGET::, *note FGETC:: - - -File: gfortran.info, Node: FPUTC, Next: FRACTION, Prev: FPUT, Up: Intrinsic Procedures - -8.90 'FPUTC' -- Write a single character in stream mode -======================================================= - -_Description_: - Write a single character in stream mode by bypassing normal - formatted output. Stream I/O should not be mixed with normal - record-oriented (formatted or unformatted) I/O on the same unit; - the results are unpredictable. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - Note that the 'FGET' intrinsic is provided for backwards - compatibility with 'g77'. GNU Fortran provides the Fortran 2003 - Stream facility. Programmers should consider the use of new stream - IO feature in new code for future portability. See also *note - Fortran 2003 status::. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FPUTC(UNIT, C [, STATUS])' - 'STATUS = FPUTC(UNIT, C)' - -_Arguments_: - UNIT The type shall be 'INTEGER'. - C The type shall be 'CHARACTER' and of default - kind. - STATUS (Optional) status flag of type 'INTEGER'. - Returns 0 on success, -1 on end-of-file and a - system specific positive error code otherwise. - -_Example_: - PROGRAM test_fputc - CHARACTER(len=10) :: str = "gfortran" - INTEGER :: fd = 42, i - - OPEN(UNIT = fd, FILE = "out", ACTION = "WRITE", STATUS="NEW") - DO i = 1, len_trim(str) - CALL fputc(fd, str(i:i)) - END DO - CLOSE(fd) - END PROGRAM - -_See also_: - *note FPUT::, *note FGET::, *note FGETC:: - - -File: gfortran.info, Node: FRACTION, Next: FREE, Prev: FPUTC, Up: Intrinsic Procedures - -8.91 'FRACTION' -- Fractional part of the model representation -============================================================== - -_Description_: - 'FRACTION(X)' returns the fractional part of the model - representation of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'Y = FRACTION(X)' - -_Arguments_: - X The type of the argument shall be a 'REAL'. - -_Return value_: - The return value is of the same type and kind as the argument. The - fractional part of the model representation of 'X' is returned; it - is 'X * RADIX(X)**(-EXPONENT(X))'. - -_Example_: - program test_fraction - real :: x - x = 178.1387e-4 - print *, fraction(x), x * radix(x)**(-exponent(x)) - end program test_fraction - - -File: gfortran.info, Node: FREE, Next: FSEEK, Prev: FRACTION, Up: Intrinsic Procedures - -8.92 'FREE' -- Frees memory -=========================== - -_Description_: - Frees memory previously allocated by 'MALLOC'. The 'FREE' - intrinsic is an extension intended to be used with Cray pointers, - and is provided in GNU Fortran to allow user to compile legacy - code. For new code using Fortran 95 pointers, the memory - de-allocation intrinsic is 'DEALLOCATE'. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL FREE(PTR)' - -_Arguments_: - PTR The type shall be 'INTEGER'. It represents the - location of the memory that should be - de-allocated. - -_Return value_: - None - -_Example_: - See 'MALLOC' for an example. - -_See also_: - *note MALLOC:: - - -File: gfortran.info, Node: FSEEK, Next: FSTAT, Prev: FREE, Up: Intrinsic Procedures - -8.93 'FSEEK' -- Low level file positioning subroutine -===================================================== - -_Description_: - Moves UNIT to the specified OFFSET. If WHENCE is set to 0, the - OFFSET is taken as an absolute value 'SEEK_SET', if set to 1, - OFFSET is taken to be relative to the current position 'SEEK_CUR', - and if set to 2 relative to the end of the file 'SEEK_END'. On - error, STATUS is set to a nonzero value. If STATUS the seek fails - silently. - - This intrinsic routine is not fully backwards compatible with - 'g77'. In 'g77', the 'FSEEK' takes a statement label instead of a - STATUS variable. If FSEEK is used in old code, change - CALL FSEEK(UNIT, OFFSET, WHENCE, *label) - to - INTEGER :: status - CALL FSEEK(UNIT, OFFSET, WHENCE, status) - IF (status /= 0) GOTO label - - Please note that GNU Fortran provides the Fortran 2003 Stream - facility. Programmers should consider the use of new stream IO - feature in new code for future portability. See also *note Fortran - 2003 status::. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL FSEEK(UNIT, OFFSET, WHENCE[, STATUS])' - -_Arguments_: - UNIT Shall be a scalar of type 'INTEGER'. - OFFSET Shall be a scalar of type 'INTEGER'. - WHENCE Shall be a scalar of type 'INTEGER'. Its value - shall be either 0, 1 or 2. - STATUS (Optional) shall be a scalar of type - 'INTEGER(4)'. - -_Example_: - PROGRAM test_fseek - INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2 - INTEGER :: fd, offset, ierr - - ierr = 0 - offset = 5 - fd = 10 - - OPEN(UNIT=fd, FILE="fseek.test") - CALL FSEEK(fd, offset, SEEK_SET, ierr) ! move to OFFSET - print *, FTELL(fd), ierr - - CALL FSEEK(fd, 0, SEEK_END, ierr) ! move to end - print *, FTELL(fd), ierr - - CALL FSEEK(fd, 0, SEEK_SET, ierr) ! move to beginning - print *, FTELL(fd), ierr - - CLOSE(UNIT=fd) - END PROGRAM - -_See also_: - *note FTELL:: - - -File: gfortran.info, Node: FSTAT, Next: FTELL, Prev: FSEEK, Up: Intrinsic Procedures - -8.94 'FSTAT' -- Get file status -=============================== - -_Description_: - 'FSTAT' is identical to *note STAT::, except that information about - an already opened file is obtained. - - The elements in 'VALUES' are the same as described by *note STAT::. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FSTAT(UNIT, VALUES [, STATUS])' - 'STATUS = FSTAT(UNIT, VALUES)' - -_Arguments_: - UNIT An open I/O unit number of type 'INTEGER'. - VALUES The type shall be 'INTEGER(4), DIMENSION(13)'. - STATUS (Optional) status flag of type 'INTEGER(4)'. - Returns 0 on success and a system specific error - code otherwise. - -_Example_: - See *note STAT:: for an example. - -_See also_: - To stat a link: *note LSTAT::, to stat a file: *note STAT:: - - -File: gfortran.info, Node: FTELL, Next: GAMMA, Prev: FSTAT, Up: Intrinsic Procedures - -8.95 'FTELL' -- Current stream position -======================================= - -_Description_: - Retrieves the current position within an open file. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL FTELL(UNIT, OFFSET)' - 'OFFSET = FTELL(UNIT)' - -_Arguments_: - OFFSET Shall of type 'INTEGER'. - UNIT Shall of type 'INTEGER'. - -_Return value_: - In either syntax, OFFSET is set to the current offset of unit - number UNIT, or to -1 if the unit is not currently open. - -_Example_: - PROGRAM test_ftell - INTEGER :: i - OPEN(10, FILE="temp.dat") - CALL ftell(10,i) - WRITE(*,*) i - END PROGRAM - -_See also_: - *note FSEEK:: - - -File: gfortran.info, Node: GAMMA, Next: GERROR, Prev: FTELL, Up: Intrinsic Procedures - -8.96 'GAMMA' -- Gamma function -============================== - -_Description_: - 'GAMMA(X)' computes Gamma (\Gamma) of X. For positive, integer - values of X the Gamma function simplifies to the factorial function - \Gamma(x)=(x-1)!. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'X = GAMMA(X)' - -_Arguments_: - X Shall be of type 'REAL' and neither zero nor a - negative integer. - -_Return value_: - The return value is of type 'REAL' of the same kind as X. - -_Example_: - program test_gamma - real :: x = 1.0 - x = gamma(x) ! returns 1.0 - end program test_gamma - -_Specific names_: - Name Argument Return type Standard - 'GAMMA(X)' 'REAL(4) X' 'REAL(4)' GNU Extension - 'DGAMMA(X)' 'REAL(8) X' 'REAL(8)' GNU Extension - -_See also_: - Logarithm of the Gamma function: *note LOG_GAMMA:: - - -File: gfortran.info, Node: GERROR, Next: GETARG, Prev: GAMMA, Up: Intrinsic Procedures - -8.97 'GERROR' -- Get last system error message -============================================== - -_Description_: - Returns the system error message corresponding to the last system - error. This resembles the functionality of 'strerror(3)' in C. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL GERROR(RESULT)' - -_Arguments_: - RESULT Shall of type 'CHARACTER' and of default - -_Example_: - PROGRAM test_gerror - CHARACTER(len=100) :: msg - CALL gerror(msg) - WRITE(*,*) msg - END PROGRAM - -_See also_: - *note IERRNO::, *note PERROR:: - - -File: gfortran.info, Node: GETARG, Next: GET_COMMAND, Prev: GERROR, Up: Intrinsic Procedures - -8.98 'GETARG' -- Get command line arguments -=========================================== - -_Description_: - Retrieve the POS-th argument that was passed on the command line - when the containing program was invoked. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. In new code, programmers should consider the use - of the *note GET_COMMAND_ARGUMENT:: intrinsic defined by the - Fortran 2003 standard. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL GETARG(POS, VALUE)' - -_Arguments_: - POS Shall be of type 'INTEGER' and not wider than - the default integer kind; POS \geq 0 - VALUE Shall be of type 'CHARACTER' and of default - kind. - VALUE Shall be of type 'CHARACTER'. - -_Return value_: - After 'GETARG' returns, the VALUE argument holds the POSth command - line argument. If VALUE can not hold the argument, it is truncated - to fit the length of VALUE. If there are less than POS arguments - specified at the command line, VALUE will be filled with blanks. - If POS = 0, VALUE is set to the name of the program (on systems - that support this feature). - -_Example_: - PROGRAM test_getarg - INTEGER :: i - CHARACTER(len=32) :: arg - - DO i = 1, iargc() - CALL getarg(i, arg) - WRITE (*,*) arg - END DO - END PROGRAM - -_See also_: - GNU Fortran 77 compatibility function: *note IARGC:: - - Fortran 2003 functions and subroutines: *note GET_COMMAND::, *note - GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT:: - - -File: gfortran.info, Node: GET_COMMAND, Next: GET_COMMAND_ARGUMENT, Prev: GETARG, Up: Intrinsic Procedures - -8.99 'GET_COMMAND' -- Get the entire command line -================================================= - -_Description_: - Retrieve the entire command line that was used to invoke the - program. - -_Standard_: - Fortran 2003 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL GET_COMMAND([COMMAND, LENGTH, STATUS])' - -_Arguments_: - COMMAND (Optional) shall be of type 'CHARACTER' and of - default kind. - LENGTH (Optional) Shall be of type 'INTEGER' and of - default kind. - STATUS (Optional) Shall be of type 'INTEGER' and of - default kind. - -_Return value_: - If COMMAND is present, stores the entire command line that was used - to invoke the program in COMMAND. If LENGTH is present, it is - assigned the length of the command line. If STATUS is present, it - is assigned 0 upon success of the command, -1 if COMMAND is too - short to store the command line, or a positive value in case of an - error. - -_Example_: - PROGRAM test_get_command - CHARACTER(len=255) :: cmd - CALL get_command(cmd) - WRITE (*,*) TRIM(cmd) - END PROGRAM - -_See also_: - *note GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT:: - - -File: gfortran.info, Node: GET_COMMAND_ARGUMENT, Next: GETCWD, Prev: GET_COMMAND, Up: Intrinsic Procedures - -8.100 'GET_COMMAND_ARGUMENT' -- Get command line arguments -========================================================== - -_Description_: - Retrieve the NUMBER-th argument that was passed on the command line - when the containing program was invoked. - -_Standard_: - Fortran 2003 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])' - -_Arguments_: - NUMBER Shall be a scalar of type 'INTEGER' and of - default kind, NUMBER \geq 0 - VALUE (Optional) Shall be a scalar of type 'CHARACTER' - and of default kind. - LENGTH (Optional) Shall be a scalar of type 'INTEGER' - and of default kind. - STATUS (Optional) Shall be a scalar of type 'INTEGER' - and of default kind. - -_Return value_: - After 'GET_COMMAND_ARGUMENT' returns, the VALUE argument holds the - NUMBER-th command line argument. If VALUE can not hold the - argument, it is truncated to fit the length of VALUE. If there are - less than NUMBER arguments specified at the command line, VALUE - will be filled with blanks. If NUMBER = 0, VALUE is set to the - name of the program (on systems that support this feature). The - LENGTH argument contains the length of the NUMBER-th command line - argument. If the argument retrieval fails, STATUS is a positive - number; if VALUE contains a truncated command line argument, STATUS - is -1; and otherwise the STATUS is zero. - -_Example_: - PROGRAM test_get_command_argument - INTEGER :: i - CHARACTER(len=32) :: arg - - i = 0 - DO - CALL get_command_argument(i, arg) - IF (LEN_TRIM(arg) == 0) EXIT - - WRITE (*,*) TRIM(arg) - i = i+1 - END DO - END PROGRAM - -_See also_: - *note GET_COMMAND::, *note COMMAND_ARGUMENT_COUNT:: - - -File: gfortran.info, Node: GETCWD, Next: GETENV, Prev: GET_COMMAND_ARGUMENT, Up: Intrinsic Procedures - -8.101 'GETCWD' -- Get current working directory -=============================================== - -_Description_: - Get current working directory. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL GETCWD(C [, STATUS])' - 'STATUS = GETCWD(C)' - -_Arguments_: - C The type shall be 'CHARACTER' and of default - kind. - STATUS (Optional) status flag. Returns 0 on success, a - system specific and nonzero error code - otherwise. - -_Example_: - PROGRAM test_getcwd - CHARACTER(len=255) :: cwd - CALL getcwd(cwd) - WRITE(*,*) TRIM(cwd) - END PROGRAM - -_See also_: - *note CHDIR:: - - -File: gfortran.info, Node: GETENV, Next: GET_ENVIRONMENT_VARIABLE, Prev: GETCWD, Up: Intrinsic Procedures - -8.102 'GETENV' -- Get an environmental variable -=============================================== - -_Description_: - Get the VALUE of the environmental variable NAME. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. In new code, programmers should consider the use - of the *note GET_ENVIRONMENT_VARIABLE:: intrinsic defined by the - Fortran 2003 standard. - - Note that 'GETENV' need not be thread-safe. It is the - responsibility of the user to ensure that the environment is not - being updated concurrently with a call to the 'GETENV' intrinsic. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL GETENV(NAME, VALUE)' - -_Arguments_: - NAME Shall be of type 'CHARACTER' and of default - kind. - VALUE Shall be of type 'CHARACTER' and of default - kind. - -_Return value_: - Stores the value of NAME in VALUE. If VALUE is not large enough to - hold the data, it is truncated. If NAME is not set, VALUE will be - filled with blanks. - -_Example_: - PROGRAM test_getenv - CHARACTER(len=255) :: homedir - CALL getenv("HOME", homedir) - WRITE (*,*) TRIM(homedir) - END PROGRAM - -_See also_: - *note GET_ENVIRONMENT_VARIABLE:: - - -File: gfortran.info, Node: GET_ENVIRONMENT_VARIABLE, Next: GETGID, Prev: GETENV, Up: Intrinsic Procedures - -8.103 'GET_ENVIRONMENT_VARIABLE' -- Get an environmental variable -================================================================= - -_Description_: - Get the VALUE of the environmental variable NAME. - - Note that 'GET_ENVIRONMENT_VARIABLE' need not be thread-safe. It - is the responsibility of the user to ensure that the environment is - not being updated concurrently with a call to the - 'GET_ENVIRONMENT_VARIABLE' intrinsic. - -_Standard_: - Fortran 2003 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS, - TRIM_NAME)' - -_Arguments_: - NAME Shall be a scalar of type 'CHARACTER' and of - default kind. - VALUE (Optional) Shall be a scalar of type 'CHARACTER' - and of default kind. - LENGTH (Optional) Shall be a scalar of type 'INTEGER' - and of default kind. - STATUS (Optional) Shall be a scalar of type 'INTEGER' - and of default kind. - TRIM_NAME (Optional) Shall be a scalar of type 'LOGICAL' - and of default kind. - -_Return value_: - Stores the value of NAME in VALUE. If VALUE is not large enough to - hold the data, it is truncated. If NAME is not set, VALUE will be - filled with blanks. Argument LENGTH contains the length needed for - storing the environment variable NAME or zero if it is not present. - STATUS is -1 if VALUE is present but too short for the environment - variable; it is 1 if the environment variable does not exist and 2 - if the processor does not support environment variables; in all - other cases STATUS is zero. If TRIM_NAME is present with the value - '.FALSE.', the trailing blanks in NAME are significant; otherwise - they are not part of the environment variable name. - -_Example_: - PROGRAM test_getenv - CHARACTER(len=255) :: homedir - CALL get_environment_variable("HOME", homedir) - WRITE (*,*) TRIM(homedir) - END PROGRAM - - -File: gfortran.info, Node: GETGID, Next: GETLOG, Prev: GET_ENVIRONMENT_VARIABLE, Up: Intrinsic Procedures - -8.104 'GETGID' -- Group ID function -=================================== - -_Description_: - Returns the numerical group ID of the current process. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = GETGID()' - -_Return value_: - The return value of 'GETGID' is an 'INTEGER' of the default kind. - -_Example_: - See 'GETPID' for an example. - -_See also_: - *note GETPID::, *note GETUID:: - - -File: gfortran.info, Node: GETLOG, Next: GETPID, Prev: GETGID, Up: Intrinsic Procedures - -8.105 'GETLOG' -- Get login name -================================ - -_Description_: - Gets the username under which the program is running. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL GETLOG(C)' - -_Arguments_: - C Shall be of type 'CHARACTER' and of default - kind. - -_Return value_: - Stores the current user name in LOGIN. (On systems where POSIX - functions 'geteuid' and 'getpwuid' are not available, and the - 'getlogin' function is not implemented either, this will return a - blank string.) - -_Example_: - PROGRAM TEST_GETLOG - CHARACTER(32) :: login - CALL GETLOG(login) - WRITE(*,*) login - END PROGRAM - -_See also_: - *note GETUID:: - - -File: gfortran.info, Node: GETPID, Next: GETUID, Prev: GETLOG, Up: Intrinsic Procedures - -8.106 'GETPID' -- Process ID function -===================================== - -_Description_: - Returns the numerical process identifier of the current process. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = GETPID()' - -_Return value_: - The return value of 'GETPID' is an 'INTEGER' of the default kind. - -_Example_: - program info - print *, "The current process ID is ", getpid() - print *, "Your numerical user ID is ", getuid() - print *, "Your numerical group ID is ", getgid() - end program info - -_See also_: - *note GETGID::, *note GETUID:: - - -File: gfortran.info, Node: GETUID, Next: GMTIME, Prev: GETPID, Up: Intrinsic Procedures - -8.107 'GETUID' -- User ID function -================================== - -_Description_: - Returns the numerical user ID of the current process. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = GETUID()' - -_Return value_: - The return value of 'GETUID' is an 'INTEGER' of the default kind. - -_Example_: - See 'GETPID' for an example. - -_See also_: - *note GETPID::, *note GETLOG:: - - -File: gfortran.info, Node: GMTIME, Next: HOSTNM, Prev: GETUID, Up: Intrinsic Procedures - -8.108 'GMTIME' -- Convert time to GMT info -========================================== - -_Description_: - Given a system time value TIME (as provided by the 'TIME8' - intrinsic), fills VALUES with values extracted from it appropriate - to the UTC time zone (Universal Coordinated Time, also known in - some countries as GMT, Greenwich Mean Time), using 'gmtime(3)'. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL GMTIME(TIME, VALUES)' - -_Arguments_: - TIME An 'INTEGER' scalar expression corresponding to - a system time, with 'INTENT(IN)'. - VALUES A default 'INTEGER' array with 9 elements, with - 'INTENT(OUT)'. - -_Return value_: - The elements of VALUES are assigned as follows: - 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap - seconds - 2. Minutes after the hour, range 0-59 - 3. Hours past midnight, range 0-23 - 4. Day of month, range 0-31 - 5. Number of months since January, range 0-12 - 6. Years since 1900 - 7. Number of days since Sunday, range 0-6 - 8. Days since January 1 - 9. Daylight savings indicator: positive if daylight savings is in - effect, zero if not, and negative if the information is not - available. - -_See also_: - *note CTIME::, *note LTIME::, *note TIME::, *note TIME8:: - - -File: gfortran.info, Node: HOSTNM, Next: HUGE, Prev: GMTIME, Up: Intrinsic Procedures - -8.109 'HOSTNM' -- Get system host name -====================================== - -_Description_: - Retrieves the host name of the system on which the program is - running. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL HOSTNM(C [, STATUS])' - 'STATUS = HOSTNM(NAME)' - -_Arguments_: - C Shall of type 'CHARACTER' and of default kind. - STATUS (Optional) status flag of type 'INTEGER'. - Returns 0 on success, or a system specific error - code otherwise. - -_Return value_: - In either syntax, NAME is set to the current hostname if it can be - obtained, or to a blank string otherwise. - - -File: gfortran.info, Node: HUGE, Next: HYPOT, Prev: HOSTNM, Up: Intrinsic Procedures - -8.110 'HUGE' -- Largest number of a kind -======================================== - -_Description_: - 'HUGE(X)' returns the largest number that is not an infinity in the - model of the type of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = HUGE(X)' - -_Arguments_: - X Shall be of type 'REAL' or 'INTEGER'. - -_Return value_: - The return value is of the same type and kind as X - -_Example_: - program test_huge_tiny - print *, huge(0), huge(0.0), huge(0.0d0) - print *, tiny(0.0), tiny(0.0d0) - end program test_huge_tiny - - -File: gfortran.info, Node: HYPOT, Next: IACHAR, Prev: HUGE, Up: Intrinsic Procedures - -8.111 'HYPOT' -- Euclidean distance function -============================================ - -_Description_: - 'HYPOT(X,Y)' is the Euclidean distance function. It is equal to - \sqrt{X^2 + Y^2}, without undue underflow or overflow. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = HYPOT(X, Y)' - -_Arguments_: - X The type shall be 'REAL'. - Y The type and kind type parameter shall be the - same as X. - -_Return value_: - The return value has the same type and kind type parameter as X. - -_Example_: - program test_hypot - real(4) :: x = 1.e0_4, y = 0.5e0_4 - x = hypot(x,y) - end program test_hypot - - -File: gfortran.info, Node: IACHAR, Next: IALL, Prev: HYPOT, Up: Intrinsic Procedures - -8.112 'IACHAR' -- Code in ASCII collating sequence -================================================== - -_Description_: - 'IACHAR(C)' returns the code for the ASCII character in the first - character position of 'C'. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IACHAR(C [, KIND])' - -_Arguments_: - C Shall be a scalar 'CHARACTER', with 'INTENT(IN)' - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Example_: - program test_iachar - integer i - i = iachar(' ') - end program test_iachar - -_Note_: - See *note ICHAR:: for a discussion of converting between numerical - values and formatted string representations. - -_See also_: - *note ACHAR::, *note CHAR::, *note ICHAR:: - - -File: gfortran.info, Node: IALL, Next: IAND, Prev: IACHAR, Up: Intrinsic Procedures - -8.113 'IALL' -- Bitwise AND of array elements -============================================= - -_Description_: - Reduces with bitwise AND the elements of ARRAY along dimension DIM - if the corresponding element in MASK is 'TRUE'. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = IALL(ARRAY[, MASK])' - 'RESULT = IALL(ARRAY, DIM[, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type 'LOGICAL' and either - be a scalar or an array of the same shape as - ARRAY. - -_Return value_: - The result is of the same type as ARRAY. - - If DIM is absent, a scalar with the bitwise ALL of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals - the rank of ARRAY, and a shape similar to that of ARRAY with - dimension DIM dropped is returned. - -_Example_: - PROGRAM test_iall - INTEGER(1) :: a(2) - - a(1) = b'00100100' - a(2) = b'01101010' - - ! prints 00100000 - PRINT '(b8.8)', IALL(a) - END PROGRAM - -_See also_: - *note IANY::, *note IPARITY::, *note IAND:: - - -File: gfortran.info, Node: IAND, Next: IANY, Prev: IALL, Up: Intrinsic Procedures - -8.114 'IAND' -- Bitwise logical and -=================================== - -_Description_: - Bitwise logical 'AND'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IAND(I, J)' - -_Arguments_: - I The type shall be 'INTEGER'. - J The type shall be 'INTEGER', of the same kind as - I. (As a GNU extension, different kinds are - also permitted.) - -_Return value_: - The return type is 'INTEGER', of the same kind as the arguments. - (If the argument kinds differ, it is of the same kind as the larger - argument.) - -_Example_: - PROGRAM test_iand - INTEGER :: a, b - DATA a / Z'F' /, b / Z'3' / - WRITE (*,*) IAND(a, b) - END PROGRAM - -_See also_: - *note IOR::, *note IEOR::, *note IBITS::, *note IBSET::, *note - IBCLR::, *note NOT:: - - -File: gfortran.info, Node: IANY, Next: IARGC, Prev: IAND, Up: Intrinsic Procedures - -8.115 'IANY' -- Bitwise OR of array elements -============================================ - -_Description_: - Reduces with bitwise OR (inclusive or) the elements of ARRAY along - dimension DIM if the corresponding element in MASK is 'TRUE'. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = IANY(ARRAY[, MASK])' - 'RESULT = IANY(ARRAY, DIM[, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type 'LOGICAL' and either - be a scalar or an array of the same shape as - ARRAY. - -_Return value_: - The result is of the same type as ARRAY. - - If DIM is absent, a scalar with the bitwise OR of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals - the rank of ARRAY, and a shape similar to that of ARRAY with - dimension DIM dropped is returned. - -_Example_: - PROGRAM test_iany - INTEGER(1) :: a(2) - - a(1) = b'00100100' - a(2) = b'01101010' - - ! prints 01101110 - PRINT '(b8.8)', IANY(a) - END PROGRAM - -_See also_: - *note IPARITY::, *note IALL::, *note IOR:: - - -File: gfortran.info, Node: IARGC, Next: IBCLR, Prev: IANY, Up: Intrinsic Procedures - -8.116 'IARGC' -- Get the number of command line arguments -========================================================= - -_Description_: - 'IARGC' returns the number of arguments passed on the command line - when the containing program was invoked. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. In new code, programmers should consider the use - of the *note COMMAND_ARGUMENT_COUNT:: intrinsic defined by the - Fortran 2003 standard. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = IARGC()' - -_Arguments_: - None. - -_Return value_: - The number of command line arguments, type 'INTEGER(4)'. - -_Example_: - See *note GETARG:: - -_See also_: - GNU Fortran 77 compatibility subroutine: *note GETARG:: - - Fortran 2003 functions and subroutines: *note GET_COMMAND::, *note - GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT:: - - -File: gfortran.info, Node: IBCLR, Next: IBITS, Prev: IARGC, Up: Intrinsic Procedures - -8.117 'IBCLR' -- Clear bit -========================== - -_Description_: - 'IBCLR' returns the value of I with the bit at position POS set to - zero. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IBCLR(I, POS)' - -_Arguments_: - I The type shall be 'INTEGER'. - POS The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note IBITS::, *note IBSET::, *note IAND::, *note IOR::, *note - IEOR::, *note MVBITS:: - - -File: gfortran.info, Node: IBITS, Next: IBSET, Prev: IBCLR, Up: Intrinsic Procedures - -8.118 'IBITS' -- Bit extraction -=============================== - -_Description_: - 'IBITS' extracts a field of length LEN from I, starting from bit - position POS and extending left for LEN bits. The result is - right-justified and the remaining bits are zeroed. The value of - 'POS+LEN' must be less than or equal to the value 'BIT_SIZE(I)'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IBITS(I, POS, LEN)' - -_Arguments_: - I The type shall be 'INTEGER'. - POS The type shall be 'INTEGER'. - LEN The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note BIT_SIZE::, *note IBCLR::, *note IBSET::, *note IAND::, *note - IOR::, *note IEOR:: - - -File: gfortran.info, Node: IBSET, Next: ICHAR, Prev: IBITS, Up: Intrinsic Procedures - -8.119 'IBSET' -- Set bit -======================== - -_Description_: - 'IBSET' returns the value of I with the bit at position POS set to - one. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IBSET(I, POS)' - -_Arguments_: - I The type shall be 'INTEGER'. - POS The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note IBCLR::, *note IBITS::, *note IAND::, *note IOR::, *note - IEOR::, *note MVBITS:: - - -File: gfortran.info, Node: ICHAR, Next: IDATE, Prev: IBSET, Up: Intrinsic Procedures - -8.120 'ICHAR' -- Character-to-integer conversion function -========================================================= - -_Description_: - 'ICHAR(C)' returns the code for the character in the first - character position of 'C' in the system's native character set. - The correspondence between characters and their codes is not - necessarily the same across different GNU Fortran implementations. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ICHAR(C [, KIND])' - -_Arguments_: - C Shall be a scalar 'CHARACTER', with 'INTENT(IN)' - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Example_: - program test_ichar - integer i - i = ichar(' ') - end program test_ichar - -_Specific names_: - Name Argument Return type Standard - 'ICHAR(C)' 'CHARACTER 'INTEGER(4)' Fortran 77 and - C' later - -_Note_: - No intrinsic exists to convert between a numeric value and a - formatted character string representation - for instance, given the - 'CHARACTER' value ''154'', obtaining an 'INTEGER' or 'REAL' value - with the value 154, or vice versa. Instead, this functionality is - provided by internal-file I/O, as in the following example: - program read_val - integer value - character(len=10) string, string2 - string = '154' - - ! Convert a string to a numeric value - read (string,'(I10)') value - print *, value - - ! Convert a value to a formatted string - write (string2,'(I10)') value - print *, string2 - end program read_val - -_See also_: - *note ACHAR::, *note CHAR::, *note IACHAR:: - - -File: gfortran.info, Node: IDATE, Next: IEOR, Prev: ICHAR, Up: Intrinsic Procedures - -8.121 'IDATE' -- Get current local time subroutine (day/month/year) -=================================================================== - -_Description_: - 'IDATE(VALUES)' Fills VALUES with the numerical values at the - current local time. The day (in the range 1-31), month (in the - range 1-12), and year appear in elements 1, 2, and 3 of VALUES, - respectively. The year has four significant digits. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL IDATE(VALUES)' - -_Arguments_: - VALUES The type shall be 'INTEGER, DIMENSION(3)' and - the kind shall be the default integer kind. - -_Return value_: - Does not return anything. - -_Example_: - program test_idate - integer, dimension(3) :: tarray - call idate(tarray) - print *, tarray(1) - print *, tarray(2) - print *, tarray(3) - end program test_idate - - -File: gfortran.info, Node: IEOR, Next: IERRNO, Prev: IDATE, Up: Intrinsic Procedures - -8.122 'IEOR' -- Bitwise logical exclusive or -============================================ - -_Description_: - 'IEOR' returns the bitwise Boolean exclusive-OR of I and J. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IEOR(I, J)' - -_Arguments_: - I The type shall be 'INTEGER'. - J The type shall be 'INTEGER', of the same kind as - I. (As a GNU extension, different kinds are - also permitted.) - -_Return value_: - The return type is 'INTEGER', of the same kind as the arguments. - (If the argument kinds differ, it is of the same kind as the larger - argument.) - -_See also_: - *note IOR::, *note IAND::, *note IBITS::, *note IBSET::, *note - IBCLR::, *note NOT:: - - -File: gfortran.info, Node: IERRNO, Next: IMAGE_INDEX, Prev: IEOR, Up: Intrinsic Procedures - -8.123 'IERRNO' -- Get the last system error number -================================================== - -_Description_: - Returns the last system error number, as given by the C 'errno' - variable. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = IERRNO()' - -_Arguments_: - None. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_See also_: - *note PERROR:: - - -File: gfortran.info, Node: IMAGE_INDEX, Next: INDEX intrinsic, Prev: IERRNO, Up: Intrinsic Procedures - -8.124 'IMAGE_INDEX' -- Function that converts a cosubscript to an image index -============================================================================= - -_Description_: - Returns the image index belonging to a cosubscript. - -_Standard_: - Fortran 2008 and later - -_Class_: - Inquiry function. - -_Syntax_: - 'RESULT = IMAGE_INDEX(COARRAY, SUB)' - -_Arguments_: None. - COARRAY Coarray of any type. - SUB default integer rank-1 array of a size equal to - the corank of COARRAY. - -_Return value_: - Scalar default integer with the value of the image index which - corresponds to the cosubscripts. For invalid cosubscripts the - result is zero. - -_Example_: - INTEGER :: array[2,-1:4,8,*] - ! Writes 28 (or 0 if there are fewer than 28 images) - WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1]) - -_See also_: - *note THIS_IMAGE::, *note NUM_IMAGES:: - - -File: gfortran.info, Node: INDEX intrinsic, Next: INT, Prev: IMAGE_INDEX, Up: Intrinsic Procedures - -8.125 'INDEX' -- Position of a substring within a string -======================================================== - -_Description_: - Returns the position of the start of the first occurrence of string - SUBSTRING as a substring in STRING, counting from one. If - SUBSTRING is not present in STRING, zero is returned. If the BACK - argument is present and true, the return value is the start of the - last occurrence rather than the first. - -_Standard_: - Fortran 77 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = INDEX(STRING, SUBSTRING [, BACK [, KIND]])' - -_Arguments_: - STRING Shall be a scalar 'CHARACTER', with 'INTENT(IN)' - SUBSTRING Shall be a scalar 'CHARACTER', with 'INTENT(IN)' - BACK (Optional) Shall be a scalar 'LOGICAL', with - 'INTENT(IN)' - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Specific names_: - Name Argument Return type Standard - 'INDEX(STRING, 'CHARACTER' 'INTEGER(4)' Fortran 77 and - SUBSTRING)' later - -_See also_: - *note SCAN::, *note VERIFY:: - - -File: gfortran.info, Node: INT, Next: INT2, Prev: INDEX intrinsic, Up: Intrinsic Procedures - -8.126 'INT' -- Convert to integer type -====================================== - -_Description_: - Convert to integer type - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = INT(A [, KIND))' - -_Arguments_: - A Shall be of type 'INTEGER', 'REAL', or - 'COMPLEX'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - These functions return a 'INTEGER' variable or array under the - following rules: - - (A) - If A is of type 'INTEGER', 'INT(A) = A' - (B) - If A is of type 'REAL' and |A| < 1, 'INT(A)' equals '0'. If - |A| \geq 1, then 'INT(A)' equals the largest integer that does - not exceed the range of A and whose sign is the same as the - sign of A. - (C) - If A is of type 'COMPLEX', rule B is applied to the real part - of A. - -_Example_: - program test_int - integer :: i = 42 - complex :: z = (-3.7, 1.0) - print *, int(i) - print *, int(z), int(z,8) - end program - -_Specific names_: - Name Argument Return type Standard - 'INT(A)' 'REAL(4) A' 'INTEGER' Fortran 77 and - later - 'IFIX(A)' 'REAL(4) A' 'INTEGER' Fortran 77 and - later - 'IDINT(A)' 'REAL(8) A' 'INTEGER' Fortran 77 and - later - - -File: gfortran.info, Node: INT2, Next: INT8, Prev: INT, Up: Intrinsic Procedures - -8.127 'INT2' -- Convert to 16-bit integer type -============================================== - -_Description_: - Convert to a 'KIND=2' integer type. This is equivalent to the - standard 'INT' intrinsic with an optional argument of 'KIND=2', and - is only included for backwards compatibility. - - The 'SHORT' intrinsic is equivalent to 'INT2'. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = INT2(A)' - -_Arguments_: - A Shall be of type 'INTEGER', 'REAL', or - 'COMPLEX'. - -_Return value_: - The return value is a 'INTEGER(2)' variable. - -_See also_: - *note INT::, *note INT8::, *note LONG:: - - -File: gfortran.info, Node: INT8, Next: IOR, Prev: INT2, Up: Intrinsic Procedures - -8.128 'INT8' -- Convert to 64-bit integer type -============================================== - -_Description_: - Convert to a 'KIND=8' integer type. This is equivalent to the - standard 'INT' intrinsic with an optional argument of 'KIND=8', and - is only included for backwards compatibility. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = INT8(A)' - -_Arguments_: - A Shall be of type 'INTEGER', 'REAL', or - 'COMPLEX'. - -_Return value_: - The return value is a 'INTEGER(8)' variable. - -_See also_: - *note INT::, *note INT2::, *note LONG:: - - -File: gfortran.info, Node: IOR, Next: IPARITY, Prev: INT8, Up: Intrinsic Procedures - -8.129 'IOR' -- Bitwise logical or -================================= - -_Description_: - 'IOR' returns the bitwise Boolean inclusive-OR of I and J. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IOR(I, J)' - -_Arguments_: - I The type shall be 'INTEGER'. - J The type shall be 'INTEGER', of the same kind as - I. (As a GNU extension, different kinds are - also permitted.) - -_Return value_: - The return type is 'INTEGER', of the same kind as the arguments. - (If the argument kinds differ, it is of the same kind as the larger - argument.) - -_See also_: - *note IEOR::, *note IAND::, *note IBITS::, *note IBSET::, *note - IBCLR::, *note NOT:: - - -File: gfortran.info, Node: IPARITY, Next: IRAND, Prev: IOR, Up: Intrinsic Procedures - -8.130 'IPARITY' -- Bitwise XOR of array elements -================================================ - -_Description_: - Reduces with bitwise XOR (exclusive or) the elements of ARRAY along - dimension DIM if the corresponding element in MASK is 'TRUE'. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = IPARITY(ARRAY[, MASK])' - 'RESULT = IPARITY(ARRAY, DIM[, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type 'LOGICAL' and either - be a scalar or an array of the same shape as - ARRAY. - -_Return value_: - The result is of the same type as ARRAY. - - If DIM is absent, a scalar with the bitwise XOR of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals - the rank of ARRAY, and a shape similar to that of ARRAY with - dimension DIM dropped is returned. - -_Example_: - PROGRAM test_iparity - INTEGER(1) :: a(2) - - a(1) = b'00100100' - a(2) = b'01101010' - - ! prints 01001110 - PRINT '(b8.8)', IPARITY(a) - END PROGRAM - -_See also_: - *note IANY::, *note IALL::, *note IEOR::, *note PARITY:: - - -File: gfortran.info, Node: IRAND, Next: IS_IOSTAT_END, Prev: IPARITY, Up: Intrinsic Procedures - -8.131 'IRAND' -- Integer pseudo-random number -============================================= - -_Description_: - 'IRAND(FLAG)' returns a pseudo-random number from a uniform - distribution between 0 and a system-dependent limit (which is in - most cases 2147483647). If FLAG is 0, the next number in the - current sequence is returned; if FLAG is 1, the generator is - restarted by 'CALL SRAND(0)'; if FLAG has any other value, it is - used as a new seed with 'SRAND'. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. It implements a simple modulo generator as - provided by 'g77'. For new code, one should consider the use of - *note RANDOM_NUMBER:: as it implements a superior algorithm. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = IRAND(I)' - -_Arguments_: - I Shall be a scalar 'INTEGER' of kind 4. - -_Return value_: - The return value is of 'INTEGER(kind=4)' type. - -_Example_: - program test_irand - integer,parameter :: seed = 86456 - - call srand(seed) - print *, irand(), irand(), irand(), irand() - print *, irand(seed), irand(), irand(), irand() - end program test_irand - - -File: gfortran.info, Node: IS_IOSTAT_END, Next: IS_IOSTAT_EOR, Prev: IRAND, Up: Intrinsic Procedures - -8.132 'IS_IOSTAT_END' -- Test for end-of-file value -=================================================== - -_Description_: - 'IS_IOSTAT_END' tests whether an variable has the value of the I/O - status "end of file". The function is equivalent to comparing the - variable with the 'IOSTAT_END' parameter of the intrinsic module - 'ISO_FORTRAN_ENV'. - -_Standard_: - Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IS_IOSTAT_END(I)' - -_Arguments_: - I Shall be of the type 'INTEGER'. - -_Return value_: - Returns a 'LOGICAL' of the default kind, which '.TRUE.' if I has - the value which indicates an end of file condition for 'IOSTAT=' - specifiers, and is '.FALSE.' otherwise. - -_Example_: - PROGRAM iostat - IMPLICIT NONE - INTEGER :: stat, i - OPEN(88, FILE='test.dat') - READ(88, *, IOSTAT=stat) i - IF(IS_IOSTAT_END(stat)) STOP 'END OF FILE' - END PROGRAM - - -File: gfortran.info, Node: IS_IOSTAT_EOR, Next: ISATTY, Prev: IS_IOSTAT_END, Up: Intrinsic Procedures - -8.133 'IS_IOSTAT_EOR' -- Test for end-of-record value -===================================================== - -_Description_: - 'IS_IOSTAT_EOR' tests whether an variable has the value of the I/O - status "end of record". The function is equivalent to comparing - the variable with the 'IOSTAT_EOR' parameter of the intrinsic - module 'ISO_FORTRAN_ENV'. - -_Standard_: - Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = IS_IOSTAT_EOR(I)' - -_Arguments_: - I Shall be of the type 'INTEGER'. - -_Return value_: - Returns a 'LOGICAL' of the default kind, which '.TRUE.' if I has - the value which indicates an end of file condition for 'IOSTAT=' - specifiers, and is '.FALSE.' otherwise. - -_Example_: - PROGRAM iostat - IMPLICIT NONE - INTEGER :: stat, i(50) - OPEN(88, FILE='test.dat', FORM='UNFORMATTED') - READ(88, IOSTAT=stat) i - IF(IS_IOSTAT_EOR(stat)) STOP 'END OF RECORD' - END PROGRAM - - -File: gfortran.info, Node: ISATTY, Next: ISHFT, Prev: IS_IOSTAT_EOR, Up: Intrinsic Procedures - -8.134 'ISATTY' -- Whether a unit is a terminal device. -====================================================== - -_Description_: - Determine whether a unit is connected to a terminal device. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = ISATTY(UNIT)' - -_Arguments_: - UNIT Shall be a scalar 'INTEGER'. - -_Return value_: - Returns '.TRUE.' if the UNIT is connected to a terminal device, - '.FALSE.' otherwise. - -_Example_: - PROGRAM test_isatty - INTEGER(kind=1) :: unit - DO unit = 1, 10 - write(*,*) isatty(unit=unit) - END DO - END PROGRAM -_See also_: - *note TTYNAM:: - - -File: gfortran.info, Node: ISHFT, Next: ISHFTC, Prev: ISATTY, Up: Intrinsic Procedures - -8.135 'ISHFT' -- Shift bits -=========================== - -_Description_: - 'ISHFT' returns a value corresponding to I with all of the bits - shifted SHIFT places. A value of SHIFT greater than zero - corresponds to a left shift, a value of zero corresponds to no - shift, and a value less than zero corresponds to a right shift. If - the absolute value of SHIFT is greater than 'BIT_SIZE(I)', the - value is undefined. Bits shifted out from the left end or right - end are lost; zeros are shifted in from the opposite end. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ISHFT(I, SHIFT)' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note ISHFTC:: - - -File: gfortran.info, Node: ISHFTC, Next: ISNAN, Prev: ISHFT, Up: Intrinsic Procedures - -8.136 'ISHFTC' -- Shift bits circularly -======================================= - -_Description_: - 'ISHFTC' returns a value corresponding to I with the rightmost SIZE - bits shifted circularly SHIFT places; that is, bits shifted out one - end are shifted into the opposite end. A value of SHIFT greater - than zero corresponds to a left shift, a value of zero corresponds - to no shift, and a value less than zero corresponds to a right - shift. The absolute value of SHIFT must be less than SIZE. If the - SIZE argument is omitted, it is taken to be equivalent to - 'BIT_SIZE(I)'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = ISHFTC(I, SHIFT [, SIZE])' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - SIZE (Optional) The type shall be 'INTEGER'; the - value must be greater than zero and less than or - equal to 'BIT_SIZE(I)'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note ISHFT:: - - -File: gfortran.info, Node: ISNAN, Next: ITIME, Prev: ISHFTC, Up: Intrinsic Procedures - -8.137 'ISNAN' -- Test for a NaN -=============================== - -_Description_: - 'ISNAN' tests whether a floating-point value is an IEEE - Not-a-Number (NaN). -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'ISNAN(X)' - -_Arguments_: - X Variable of the type 'REAL'. - - -_Return value_: - Returns a default-kind 'LOGICAL'. The returned value is 'TRUE' if - X is a NaN and 'FALSE' otherwise. - -_Example_: - program test_nan - implicit none - real :: x - x = -1.0 - x = sqrt(x) - if (isnan(x)) stop '"x" is a NaN' - end program test_nan - - -File: gfortran.info, Node: ITIME, Next: KILL, Prev: ISNAN, Up: Intrinsic Procedures - -8.138 'ITIME' -- Get current local time subroutine (hour/minutes/seconds) -========================================================================= - -_Description_: - 'IDATE(VALUES)' Fills VALUES with the numerical values at the - current local time. The hour (in the range 1-24), minute (in the - range 1-60), and seconds (in the range 1-60) appear in elements 1, - 2, and 3 of VALUES, respectively. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL ITIME(VALUES)' - -_Arguments_: - VALUES The type shall be 'INTEGER, DIMENSION(3)' and - the kind shall be the default integer kind. - -_Return value_: - Does not return anything. - -_Example_: - program test_itime - integer, dimension(3) :: tarray - call itime(tarray) - print *, tarray(1) - print *, tarray(2) - print *, tarray(3) - end program test_itime - - -File: gfortran.info, Node: KILL, Next: KIND, Prev: ITIME, Up: Intrinsic Procedures - -8.139 'KILL' -- Send a signal to a process -========================================== - -_Description_: -_Standard_: - Sends the signal specified by SIGNAL to the process PID. See - 'kill(2)'. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL KILL(C, VALUE [, STATUS])' - 'STATUS = KILL(C, VALUE)' - -_Arguments_: - C Shall be a scalar 'INTEGER', with 'INTENT(IN)' - VALUE Shall be a scalar 'INTEGER', with 'INTENT(IN)' - STATUS (Optional) status flag of type 'INTEGER(4)' or - 'INTEGER(8)'. Returns 0 on success, or a - system-specific error code otherwise. - -_See also_: - *note ABORT::, *note EXIT:: - - -File: gfortran.info, Node: KIND, Next: LBOUND, Prev: KILL, Up: Intrinsic Procedures - -8.140 'KIND' -- Kind of an entity -================================= - -_Description_: - 'KIND(X)' returns the kind value of the entity X. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'K = KIND(X)' - -_Arguments_: - X Shall be of type 'LOGICAL', 'INTEGER', 'REAL', - 'COMPLEX' or 'CHARACTER'. - -_Return value_: - The return value is a scalar of type 'INTEGER' and of the default - integer kind. - -_Example_: - program test_kind - integer,parameter :: kc = kind(' ') - integer,parameter :: kl = kind(.true.) - - print *, "The default character kind is ", kc - print *, "The default logical kind is ", kl - end program test_kind - - -File: gfortran.info, Node: LBOUND, Next: LCOBOUND, Prev: KIND, Up: Intrinsic Procedures - -8.141 'LBOUND' -- Lower dimension bounds of an array -==================================================== - -_Description_: - Returns the lower bounds of an array, or a single lower bound along - the DIM dimension. -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = LBOUND(ARRAY [, DIM [, KIND]])' - -_Arguments_: - ARRAY Shall be an array, of any type. - DIM (Optional) Shall be a scalar 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. If DIM is - absent, the result is an array of the lower bounds of ARRAY. If - DIM is present, the result is a scalar corresponding to the lower - bound of the array along that dimension. If ARRAY is an expression - rather than a whole array or array structure component, or if it - has a zero extent along the relevant dimension, the lower bound is - taken to be 1. - -_See also_: - *note UBOUND::, *note LCOBOUND:: - - -File: gfortran.info, Node: LCOBOUND, Next: LEADZ, Prev: LBOUND, Up: Intrinsic Procedures - -8.142 'LCOBOUND' -- Lower codimension bounds of an array -======================================================== - -_Description_: - Returns the lower bounds of a coarray, or a single lower cobound - along the DIM codimension. -_Standard_: - Fortran 2008 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = LCOBOUND(COARRAY [, DIM [, KIND]])' - -_Arguments_: - ARRAY Shall be an coarray, of any type. - DIM (Optional) Shall be a scalar 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. If DIM is - absent, the result is an array of the lower cobounds of COARRAY. - If DIM is present, the result is a scalar corresponding to the - lower cobound of the array along that codimension. - -_See also_: - *note UCOBOUND::, *note LBOUND:: - - -File: gfortran.info, Node: LEADZ, Next: LEN, Prev: LCOBOUND, Up: Intrinsic Procedures - -8.143 'LEADZ' -- Number of leading zero bits of an integer -========================================================== - -_Description_: - 'LEADZ' returns the number of leading zero bits of an integer. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LEADZ(I)' - -_Arguments_: - I Shall be of type 'INTEGER'. - -_Return value_: - The type of the return value is the default 'INTEGER'. If all the - bits of 'I' are zero, the result value is 'BIT_SIZE(I)'. - -_Example_: - PROGRAM test_leadz - WRITE (*,*) BIT_SIZE(1) ! prints 32 - WRITE (*,*) LEADZ(1) ! prints 31 - END PROGRAM - -_See also_: - *note BIT_SIZE::, *note TRAILZ::, *note POPCNT::, *note POPPAR:: - - -File: gfortran.info, Node: LEN, Next: LEN_TRIM, Prev: LEADZ, Up: Intrinsic Procedures - -8.144 'LEN' -- Length of a character entity -=========================================== - -_Description_: - Returns the length of a character string. If STRING is an array, - the length of an element of STRING is returned. Note that STRING - need not be defined when this intrinsic is invoked, since only the - length, not the content, of STRING is needed. - -_Standard_: - Fortran 77 and later, with KIND argument Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'L = LEN(STRING [, KIND])' - -_Arguments_: - STRING Shall be a scalar or array of type 'CHARACTER', - with 'INTENT(IN)' - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Specific names_: - Name Argument Return type Standard - 'LEN(STRING)' 'CHARACTER' 'INTEGER' Fortran 77 and - later - -_See also_: - *note LEN_TRIM::, *note ADJUSTL::, *note ADJUSTR:: - - -File: gfortran.info, Node: LEN_TRIM, Next: LGE, Prev: LEN, Up: Intrinsic Procedures - -8.145 'LEN_TRIM' -- Length of a character entity without trailing blank characters -================================================================================== - -_Description_: - Returns the length of a character string, ignoring any trailing - blanks. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LEN_TRIM(STRING [, KIND])' - -_Arguments_: - STRING Shall be a scalar of type 'CHARACTER', with - 'INTENT(IN)' - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_See also_: - *note LEN::, *note ADJUSTL::, *note ADJUSTR:: - - -File: gfortran.info, Node: LGE, Next: LGT, Prev: LEN_TRIM, Up: Intrinsic Procedures - -8.146 'LGE' -- Lexical greater than or equal -============================================ - -_Description_: - Determines whether one string is lexically greater than or equal to - another string, where the two strings are interpreted as containing - ASCII character codes. If the String A and String B are not the - same length, the shorter is compared as if spaces were appended to - it to form a value that has the same length as the longer. - - In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', - and 'LLT' differ from the corresponding intrinsic operators '.GE.', - '.GT.', '.LE.', and '.LT.', in that the latter use the processor's - character ordering (which is not ASCII on some targets), whereas - the former always use the ASCII ordering. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LGE(STRING_A, STRING_B)' - -_Arguments_: - STRING_A Shall be of default 'CHARACTER' type. - STRING_B Shall be of default 'CHARACTER' type. - -_Return value_: - Returns '.TRUE.' if 'STRING_A >= STRING_B', and '.FALSE.' - otherwise, based on the ASCII ordering. - -_Specific names_: - Name Argument Return type Standard - 'LGE(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and - STRING_B)' later - -_See also_: - *note LGT::, *note LLE::, *note LLT:: - - -File: gfortran.info, Node: LGT, Next: LINK, Prev: LGE, Up: Intrinsic Procedures - -8.147 'LGT' -- Lexical greater than -=================================== - -_Description_: - Determines whether one string is lexically greater than another - string, where the two strings are interpreted as containing ASCII - character codes. If the String A and String B are not the same - length, the shorter is compared as if spaces were appended to it to - form a value that has the same length as the longer. - - In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', - and 'LLT' differ from the corresponding intrinsic operators '.GE.', - '.GT.', '.LE.', and '.LT.', in that the latter use the processor's - character ordering (which is not ASCII on some targets), whereas - the former always use the ASCII ordering. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LGT(STRING_A, STRING_B)' - -_Arguments_: - STRING_A Shall be of default 'CHARACTER' type. - STRING_B Shall be of default 'CHARACTER' type. - -_Return value_: - Returns '.TRUE.' if 'STRING_A > STRING_B', and '.FALSE.' otherwise, - based on the ASCII ordering. - -_Specific names_: - Name Argument Return type Standard - 'LGT(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and - STRING_B)' later - -_See also_: - *note LGE::, *note LLE::, *note LLT:: - - -File: gfortran.info, Node: LINK, Next: LLE, Prev: LGT, Up: Intrinsic Procedures - -8.148 'LINK' -- Create a hard link -================================== - -_Description_: - Makes a (hard) link from file PATH1 to PATH2. A null character - ('CHAR(0)') can be used to mark the end of the names in PATH1 and - PATH2; otherwise, trailing blanks in the file names are ignored. - If the STATUS argument is supplied, it contains 0 on success or a - nonzero error code upon return; see 'link(2)'. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL LINK(PATH1, PATH2 [, STATUS])' - 'STATUS = LINK(PATH1, PATH2)' - -_Arguments_: - PATH1 Shall be of default 'CHARACTER' type. - PATH2 Shall be of default 'CHARACTER' type. - STATUS (Optional) Shall be of default 'INTEGER' type. - -_See also_: - *note SYMLNK::, *note UNLINK:: - - -File: gfortran.info, Node: LLE, Next: LLT, Prev: LINK, Up: Intrinsic Procedures - -8.149 'LLE' -- Lexical less than or equal -========================================= - -_Description_: - Determines whether one string is lexically less than or equal to - another string, where the two strings are interpreted as containing - ASCII character codes. If the String A and String B are not the - same length, the shorter is compared as if spaces were appended to - it to form a value that has the same length as the longer. - - In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', - and 'LLT' differ from the corresponding intrinsic operators '.GE.', - '.GT.', '.LE.', and '.LT.', in that the latter use the processor's - character ordering (which is not ASCII on some targets), whereas - the former always use the ASCII ordering. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LLE(STRING_A, STRING_B)' - -_Arguments_: - STRING_A Shall be of default 'CHARACTER' type. - STRING_B Shall be of default 'CHARACTER' type. - -_Return value_: - Returns '.TRUE.' if 'STRING_A <= STRING_B', and '.FALSE.' - otherwise, based on the ASCII ordering. - -_Specific names_: - Name Argument Return type Standard - 'LLE(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and - STRING_B)' later - -_See also_: - *note LGE::, *note LGT::, *note LLT:: - - -File: gfortran.info, Node: LLT, Next: LNBLNK, Prev: LLE, Up: Intrinsic Procedures - -8.150 'LLT' -- Lexical less than -================================ - -_Description_: - Determines whether one string is lexically less than another - string, where the two strings are interpreted as containing ASCII - character codes. If the String A and String B are not the same - length, the shorter is compared as if spaces were appended to it to - form a value that has the same length as the longer. - - In general, the lexical comparison intrinsics 'LGE', 'LGT', 'LLE', - and 'LLT' differ from the corresponding intrinsic operators '.GE.', - '.GT.', '.LE.', and '.LT.', in that the latter use the processor's - character ordering (which is not ASCII on some targets), whereas - the former always use the ASCII ordering. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LLT(STRING_A, STRING_B)' - -_Arguments_: - STRING_A Shall be of default 'CHARACTER' type. - STRING_B Shall be of default 'CHARACTER' type. - -_Return value_: - Returns '.TRUE.' if 'STRING_A < STRING_B', and '.FALSE.' otherwise, - based on the ASCII ordering. - -_Specific names_: - Name Argument Return type Standard - 'LLT(STRING_A, 'CHARACTER' 'LOGICAL' Fortran 77 and - STRING_B)' later - -_See also_: - *note LGE::, *note LGT::, *note LLE:: - - -File: gfortran.info, Node: LNBLNK, Next: LOC, Prev: LLT, Up: Intrinsic Procedures - -8.151 'LNBLNK' -- Index of the last non-blank character in a string -=================================================================== - -_Description_: - Returns the length of a character string, ignoring any trailing - blanks. This is identical to the standard 'LEN_TRIM' intrinsic, - and is only included for backwards compatibility. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LNBLNK(STRING)' - -_Arguments_: - STRING Shall be a scalar of type 'CHARACTER', with - 'INTENT(IN)' - -_Return value_: - The return value is of 'INTEGER(kind=4)' type. - -_See also_: - *note INDEX intrinsic::, *note LEN_TRIM:: - - -File: gfortran.info, Node: LOC, Next: LOG, Prev: LNBLNK, Up: Intrinsic Procedures - -8.152 'LOC' -- Returns the address of a variable -================================================ - -_Description_: - 'LOC(X)' returns the address of X as an integer. - -_Standard_: - GNU extension - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = LOC(X)' - -_Arguments_: - X Variable of any type. - -_Return value_: - The return value is of type 'INTEGER', with a 'KIND' corresponding - to the size (in bytes) of a memory address on the target machine. - -_Example_: - program test_loc - integer :: i - real :: r - i = loc(r) - print *, i - end program test_loc - - -File: gfortran.info, Node: LOG, Next: LOG10, Prev: LOC, Up: Intrinsic Procedures - -8.153 'LOG' -- Natural logarithm function -========================================= - -_Description_: - 'LOG(X)' computes the natural logarithm of X, i.e. the logarithm - to the base e. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LOG(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value is of type 'REAL' or 'COMPLEX'. The kind type - parameter is the same as X. If X is 'COMPLEX', the imaginary part - \omega is in the range -\pi \leq \omega \leq \pi. - -_Example_: - program test_log - real(8) :: x = 2.7182818284590451_8 - complex :: z = (1.0, 2.0) - x = log(x) ! will yield (approximately) 1 - z = log(z) - end program test_log - -_Specific names_: - Name Argument Return type Standard - 'ALOG(X)' 'REAL(4) X' 'REAL(4)' f95, gnu - 'DLOG(X)' 'REAL(8) X' 'REAL(8)' f95, gnu - 'CLOG(X)' 'COMPLEX(4) 'COMPLEX(4)' f95, gnu - X' - 'ZLOG(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu - X' - 'CDLOG(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu - X' - - -File: gfortran.info, Node: LOG10, Next: LOG_GAMMA, Prev: LOG, Up: Intrinsic Procedures - -8.154 'LOG10' -- Base 10 logarithm function -=========================================== - -_Description_: - 'LOG10(X)' computes the base 10 logarithm of X. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LOG10(X)' - -_Arguments_: - X The type shall be 'REAL'. - -_Return value_: - The return value is of type 'REAL' or 'COMPLEX'. The kind type - parameter is the same as X. - -_Example_: - program test_log10 - real(8) :: x = 10.0_8 - x = log10(x) - end program test_log10 - -_Specific names_: - Name Argument Return type Standard - 'ALOG10(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and - later - 'DLOG10(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and - later - - -File: gfortran.info, Node: LOG_GAMMA, Next: LOGICAL, Prev: LOG10, Up: Intrinsic Procedures - -8.155 'LOG_GAMMA' -- Logarithm of the Gamma function -==================================================== - -_Description_: - 'LOG_GAMMA(X)' computes the natural logarithm of the absolute value - of the Gamma (\Gamma) function. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'X = LOG_GAMMA(X)' - -_Arguments_: - X Shall be of type 'REAL' and neither zero nor a - negative integer. - -_Return value_: - The return value is of type 'REAL' of the same kind as X. - -_Example_: - program test_log_gamma - real :: x = 1.0 - x = lgamma(x) ! returns 0.0 - end program test_log_gamma - -_Specific names_: - Name Argument Return type Standard - 'LGAMMA(X)' 'REAL(4) X' 'REAL(4)' GNU Extension - 'ALGAMA(X)' 'REAL(4) X' 'REAL(4)' GNU Extension - 'DLGAMA(X)' 'REAL(8) X' 'REAL(8)' GNU Extension - -_See also_: - Gamma function: *note GAMMA:: - - -File: gfortran.info, Node: LOGICAL, Next: LONG, Prev: LOG_GAMMA, Up: Intrinsic Procedures - -8.156 'LOGICAL' -- Convert to logical type -========================================== - -_Description_: - Converts one kind of 'LOGICAL' variable to another. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LOGICAL(L [, KIND])' - -_Arguments_: - L The type shall be 'LOGICAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is a 'LOGICAL' value equal to L, with a kind - corresponding to KIND, or of the default logical kind if KIND is - not given. - -_See also_: - *note INT::, *note REAL::, *note CMPLX:: - - -File: gfortran.info, Node: LONG, Next: LSHIFT, Prev: LOGICAL, Up: Intrinsic Procedures - -8.157 'LONG' -- Convert to integer type -======================================= - -_Description_: - Convert to a 'KIND=4' integer type, which is the same size as a C - 'long' integer. This is equivalent to the standard 'INT' intrinsic - with an optional argument of 'KIND=4', and is only included for - backwards compatibility. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LONG(A)' - -_Arguments_: - A Shall be of type 'INTEGER', 'REAL', or - 'COMPLEX'. - -_Return value_: - The return value is a 'INTEGER(4)' variable. - -_See also_: - *note INT::, *note INT2::, *note INT8:: - - -File: gfortran.info, Node: LSHIFT, Next: LSTAT, Prev: LONG, Up: Intrinsic Procedures - -8.158 'LSHIFT' -- Left shift bits -================================= - -_Description_: - 'LSHIFT' returns a value corresponding to I with all of the bits - shifted left by SHIFT places. If the absolute value of SHIFT is - greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted - out from the left end are lost; zeros are shifted in from the - opposite end. - - This function has been superseded by the 'ISHFT' intrinsic, which - is standard in Fortran 95 and later, and the 'SHIFTL' intrinsic, - which is standard in Fortran 2008 and later. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = LSHIFT(I, SHIFT)' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note ISHFT::, *note ISHFTC::, *note RSHIFT::, *note SHIFTA::, - *note SHIFTL::, *note SHIFTR:: - - -File: gfortran.info, Node: LSTAT, Next: LTIME, Prev: LSHIFT, Up: Intrinsic Procedures - -8.159 'LSTAT' -- Get file status -================================ - -_Description_: - 'LSTAT' is identical to *note STAT::, except that if path is a - symbolic link, then the link itself is statted, not the file that - it refers to. - - The elements in 'VALUES' are the same as described by *note STAT::. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL LSTAT(NAME, VALUES [, STATUS])' - 'STATUS = LSTAT(NAME, VALUES)' - -_Arguments_: - NAME The type shall be 'CHARACTER' of the default - kind, a valid path within the file system. - VALUES The type shall be 'INTEGER(4), DIMENSION(13)'. - STATUS (Optional) status flag of type 'INTEGER(4)'. - Returns 0 on success and a system specific error - code otherwise. - -_Example_: - See *note STAT:: for an example. - -_See also_: - To stat an open file: *note FSTAT::, to stat a file: *note STAT:: - - -File: gfortran.info, Node: LTIME, Next: MALLOC, Prev: LSTAT, Up: Intrinsic Procedures - -8.160 'LTIME' -- Convert time to local time info -================================================ - -_Description_: - Given a system time value TIME (as provided by the 'TIME8' - intrinsic), fills VALUES with values extracted from it appropriate - to the local time zone using 'localtime(3)'. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL LTIME(TIME, VALUES)' - -_Arguments_: - TIME An 'INTEGER' scalar expression corresponding to - a system time, with 'INTENT(IN)'. - VALUES A default 'INTEGER' array with 9 elements, with - 'INTENT(OUT)'. - -_Return value_: - The elements of VALUES are assigned as follows: - 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap - seconds - 2. Minutes after the hour, range 0-59 - 3. Hours past midnight, range 0-23 - 4. Day of month, range 0-31 - 5. Number of months since January, range 0-12 - 6. Years since 1900 - 7. Number of days since Sunday, range 0-6 - 8. Days since January 1 - 9. Daylight savings indicator: positive if daylight savings is in - effect, zero if not, and negative if the information is not - available. - -_See also_: - *note CTIME::, *note GMTIME::, *note TIME::, *note TIME8:: - - -File: gfortran.info, Node: MALLOC, Next: MASKL, Prev: LTIME, Up: Intrinsic Procedures - -8.161 'MALLOC' -- Allocate dynamic memory -========================================= - -_Description_: - 'MALLOC(SIZE)' allocates SIZE bytes of dynamic memory and returns - the address of the allocated memory. The 'MALLOC' intrinsic is an - extension intended to be used with Cray pointers, and is provided - in GNU Fortran to allow the user to compile legacy code. For new - code using Fortran 95 pointers, the memory allocation intrinsic is - 'ALLOCATE'. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'PTR = MALLOC(SIZE)' - -_Arguments_: - SIZE The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER(K)', with K such that - variables of type 'INTEGER(K)' have the same size as C pointers - ('sizeof(void *)'). - -_Example_: - The following example demonstrates the use of 'MALLOC' and 'FREE' - with Cray pointers. - - program test_malloc - implicit none - integer i - real*8 x(*), z - pointer(ptr_x,x) - - ptr_x = malloc(20*8) - do i = 1, 20 - x(i) = sqrt(1.0d0 / i) - end do - z = 0 - do i = 1, 20 - z = z + x(i) - print *, z - end do - call free(ptr_x) - end program test_malloc - -_See also_: - *note FREE:: - - -File: gfortran.info, Node: MASKL, Next: MASKR, Prev: MALLOC, Up: Intrinsic Procedures - -8.162 'MASKL' -- Left justified mask -==================================== - -_Description_: - 'MASKL(I[, KIND])' has its leftmost I bits set to 1, and the - remaining bits set to 0. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MASKL(I[, KIND])' - -_Arguments_: - I Shall be of type 'INTEGER'. - KIND Shall be a scalar constant expression of type - 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER'. If KIND is present, it - specifies the kind value of the return type; otherwise, it is of - the default integer kind. - -_See also_: - *note MASKR:: - - -File: gfortran.info, Node: MASKR, Next: MATMUL, Prev: MASKL, Up: Intrinsic Procedures - -8.163 'MASKR' -- Right justified mask -===================================== - -_Description_: - 'MASKL(I[, KIND])' has its rightmost I bits set to 1, and the - remaining bits set to 0. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MASKR(I[, KIND])' - -_Arguments_: - I Shall be of type 'INTEGER'. - KIND Shall be a scalar constant expression of type - 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER'. If KIND is present, it - specifies the kind value of the return type; otherwise, it is of - the default integer kind. - -_See also_: - *note MASKL:: - - -File: gfortran.info, Node: MATMUL, Next: MAX, Prev: MASKR, Up: Intrinsic Procedures - -8.164 'MATMUL' -- matrix multiplication -======================================= - -_Description_: - Performs a matrix multiplication on numeric or logical arguments. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = MATMUL(MATRIX_A, MATRIX_B)' - -_Arguments_: - MATRIX_A An array of 'INTEGER', 'REAL', 'COMPLEX', or - 'LOGICAL' type, with a rank of one or two. - MATRIX_B An array of 'INTEGER', 'REAL', or 'COMPLEX' type - if MATRIX_A is of a numeric type; otherwise, an - array of 'LOGICAL' type. The rank shall be one - or two, and the first (or only) dimension of - MATRIX_B shall be equal to the last (or only) - dimension of MATRIX_A. - -_Return value_: - The matrix product of MATRIX_A and MATRIX_B. The type and kind of - the result follow the usual type and kind promotion rules, as for - the '*' or '.AND.' operators. - -_See also_: - - -File: gfortran.info, Node: MAX, Next: MAXEXPONENT, Prev: MATMUL, Up: Intrinsic Procedures - -8.165 'MAX' -- Maximum value of an argument list -================================================ - -_Description_: - Returns the argument with the largest (most positive) value. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MAX(A1, A2 [, A3 [, ...]])' - -_Arguments_: - A1 The type shall be 'INTEGER' or 'REAL'. - A2, A3, An expression of the same type and kind as A1. - ... (As a GNU extension, arguments of different - kinds are permitted.) - -_Return value_: - The return value corresponds to the maximum value among the - arguments, and has the same type and kind as the first argument. - -_Specific names_: - Name Argument Return type Standard - 'MAX0(A1)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and - A1' later - 'AMAX0(A1)' 'INTEGER(4) 'REAL(MAX(X))' Fortran 77 and - A1' later - 'MAX1(A1)' 'REAL A1' 'INT(MAX(X))' Fortran 77 and - later - 'AMAX1(A1)' 'REAL(4) A1' 'REAL(4)' Fortran 77 and - later - 'DMAX1(A1)' 'REAL(8) A1' 'REAL(8)' Fortran 77 and - later - -_See also_: - *note MAXLOC:: *note MAXVAL::, *note MIN:: - - -File: gfortran.info, Node: MAXEXPONENT, Next: MAXLOC, Prev: MAX, Up: Intrinsic Procedures - -8.166 'MAXEXPONENT' -- Maximum exponent of a real kind -====================================================== - -_Description_: - 'MAXEXPONENT(X)' returns the maximum exponent in the model of the - type of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = MAXEXPONENT(X)' - -_Arguments_: - X Shall be of type 'REAL'. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_Example_: - program exponents - real(kind=4) :: x - real(kind=8) :: y - - print *, minexponent(x), maxexponent(x) - print *, minexponent(y), maxexponent(y) - end program exponents - - -File: gfortran.info, Node: MAXLOC, Next: MAXVAL, Prev: MAXEXPONENT, Up: Intrinsic Procedures - -8.167 'MAXLOC' -- Location of the maximum value within an array -=============================================================== - -_Description_: - Determines the location of the element in the array with the - maximum value, or, if the DIM argument is supplied, determines the - locations of the maximum element along each row of the array in the - DIM direction. If MASK is present, only the elements for which - MASK is '.TRUE.' are considered. If more than one element in the - array has the maximum value, the location returned is that of the - first such element in array element order. If the array has zero - size, or all of the elements of MASK are '.FALSE.', then the result - is an array of zeroes. Similarly, if DIM is supplied and all of - the elements of MASK along a given row are zero, the result value - for that row is zero. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = MAXLOC(ARRAY, DIM [, MASK])' - 'RESULT = MAXLOC(ARRAY [, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' or 'REAL'. - DIM (Optional) Shall be a scalar of type 'INTEGER', - with a value between one and the rank of ARRAY, - inclusive. It may not be an optional dummy - argument. - MASK Shall be an array of type 'LOGICAL', and - conformable with ARRAY. - -_Return value_: - If DIM is absent, the result is a rank-one array with a length - equal to the rank of ARRAY. If DIM is present, the result is an - array with a rank one less than the rank of ARRAY, and a size - corresponding to the size of ARRAY with the DIM dimension removed. - If DIM is present and ARRAY has a rank of one, the result is a - scalar. In all cases, the result is of default 'INTEGER' type. - -_See also_: - *note MAX::, *note MAXVAL:: - - -File: gfortran.info, Node: MAXVAL, Next: MCLOCK, Prev: MAXLOC, Up: Intrinsic Procedures - -8.168 'MAXVAL' -- Maximum value of an array -=========================================== - -_Description_: - Determines the maximum value of the elements in an array value, or, - if the DIM argument is supplied, determines the maximum value along - each row of the array in the DIM direction. If MASK is present, - only the elements for which MASK is '.TRUE.' are considered. If - the array has zero size, or all of the elements of MASK are - '.FALSE.', then the result is '-HUGE(ARRAY)' if ARRAY is numeric, - or a string of nulls if ARRAY is of character type. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = MAXVAL(ARRAY, DIM [, MASK])' - 'RESULT = MAXVAL(ARRAY [, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' or 'REAL'. - DIM (Optional) Shall be a scalar of type 'INTEGER', - with a value between one and the rank of ARRAY, - inclusive. It may not be an optional dummy - argument. - MASK Shall be an array of type 'LOGICAL', and - conformable with ARRAY. - -_Return value_: - If DIM is absent, or if ARRAY has a rank of one, the result is a - scalar. If DIM is present, the result is an array with a rank one - less than the rank of ARRAY, and a size corresponding to the size - of ARRAY with the DIM dimension removed. In all cases, the result - is of the same type and kind as ARRAY. - -_See also_: - *note MAX::, *note MAXLOC:: - - -File: gfortran.info, Node: MCLOCK, Next: MCLOCK8, Prev: MAXVAL, Up: Intrinsic Procedures - -8.169 'MCLOCK' -- Time function -=============================== - -_Description_: - Returns the number of clock ticks since the start of the process, - based on the function 'clock(3)' in the C standard library. - - This intrinsic is not fully portable, such as to systems with - 32-bit 'INTEGER' types but supporting times wider than 32 bits. - Therefore, the values returned by this intrinsic might be, or - become, negative, or numerically less than previous values, during - a single run of the compiled program. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = MCLOCK()' - -_Return value_: - The return value is a scalar of type 'INTEGER(4)', equal to the - number of clock ticks since the start of the process, or '-1' if - the system does not support 'clock(3)'. - -_See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, *note - TIME:: - - -File: gfortran.info, Node: MCLOCK8, Next: MERGE, Prev: MCLOCK, Up: Intrinsic Procedures - -8.170 'MCLOCK8' -- Time function (64-bit) -========================================= - -_Description_: - Returns the number of clock ticks since the start of the process, - based on the function 'clock(3)' in the C standard library. - - _Warning:_ this intrinsic does not increase the range of the timing - values over that returned by 'clock(3)'. On a system with a 32-bit - 'clock(3)', 'MCLOCK8' will return a 32-bit value, even though it is - converted to a 64-bit 'INTEGER(8)' value. That means overflows of - the 32-bit value can still occur. Therefore, the values returned - by this intrinsic might be or become negative or numerically less - than previous values during a single run of the compiled program. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = MCLOCK8()' - -_Return value_: - The return value is a scalar of type 'INTEGER(8)', equal to the - number of clock ticks since the start of the process, or '-1' if - the system does not support 'clock(3)'. - -_See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, *note - TIME8:: - - -File: gfortran.info, Node: MERGE, Next: MERGE_BITS, Prev: MCLOCK8, Up: Intrinsic Procedures - -8.171 'MERGE' -- Merge variables -================================ - -_Description_: - Select values from two arrays according to a logical mask. The - result is equal to TSOURCE if MASK is '.TRUE.', or equal to FSOURCE - if it is '.FALSE.'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MERGE(TSOURCE, FSOURCE, MASK)' - -_Arguments_: - TSOURCE May be of any type. - FSOURCE Shall be of the same type and type parameters as - TSOURCE. - MASK Shall be of type 'LOGICAL'. - -_Return value_: - The result is of the same type and type parameters as TSOURCE. - - -File: gfortran.info, Node: MERGE_BITS, Next: MIN, Prev: MERGE, Up: Intrinsic Procedures - -8.172 'MERGE_BITS' -- Merge of bits under mask -============================================== - -_Description_: - 'MERGE_BITS(I, J, MASK)' merges the bits of I and J as determined - by the mask. The i-th bit of the result is equal to the i-th bit - of I if the i-th bit of MASK is 1; it is equal to the i-th bit of J - otherwise. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MERGE_BITS(I, J, MASK)' - -_Arguments_: - I Shall be of type 'INTEGER'. - J Shall be of type 'INTEGER' and of the same kind - as I. - MASK Shall be of type 'INTEGER' and of the same kind - as I. - -_Return value_: - The result is of the same type and kind as I. - - -File: gfortran.info, Node: MIN, Next: MINEXPONENT, Prev: MERGE_BITS, Up: Intrinsic Procedures - -8.173 'MIN' -- Minimum value of an argument list -================================================ - -_Description_: - Returns the argument with the smallest (most negative) value. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MIN(A1, A2 [, A3, ...])' - -_Arguments_: - A1 The type shall be 'INTEGER' or 'REAL'. - A2, A3, An expression of the same type and kind as A1. - ... (As a GNU extension, arguments of different - kinds are permitted.) - -_Return value_: - The return value corresponds to the maximum value among the - arguments, and has the same type and kind as the first argument. - -_Specific names_: - Name Argument Return type Standard - 'MIN0(A1)' 'INTEGER(4) 'INTEGER(4)' Fortran 77 and - A1' later - 'AMIN0(A1)' 'INTEGER(4) 'REAL(4)' Fortran 77 and - A1' later - 'MIN1(A1)' 'REAL A1' 'INTEGER(4)' Fortran 77 and - later - 'AMIN1(A1)' 'REAL(4) A1' 'REAL(4)' Fortran 77 and - later - 'DMIN1(A1)' 'REAL(8) A1' 'REAL(8)' Fortran 77 and - later - -_See also_: - *note MAX::, *note MINLOC::, *note MINVAL:: - - -File: gfortran.info, Node: MINEXPONENT, Next: MINLOC, Prev: MIN, Up: Intrinsic Procedures - -8.174 'MINEXPONENT' -- Minimum exponent of a real kind -====================================================== - -_Description_: - 'MINEXPONENT(X)' returns the minimum exponent in the model of the - type of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = MINEXPONENT(X)' - -_Arguments_: - X Shall be of type 'REAL'. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_Example_: - See 'MAXEXPONENT' for an example. - - -File: gfortran.info, Node: MINLOC, Next: MINVAL, Prev: MINEXPONENT, Up: Intrinsic Procedures - -8.175 'MINLOC' -- Location of the minimum value within an array -=============================================================== - -_Description_: - Determines the location of the element in the array with the - minimum value, or, if the DIM argument is supplied, determines the - locations of the minimum element along each row of the array in the - DIM direction. If MASK is present, only the elements for which - MASK is '.TRUE.' are considered. If more than one element in the - array has the minimum value, the location returned is that of the - first such element in array element order. If the array has zero - size, or all of the elements of MASK are '.FALSE.', then the result - is an array of zeroes. Similarly, if DIM is supplied and all of - the elements of MASK along a given row are zero, the result value - for that row is zero. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = MINLOC(ARRAY, DIM [, MASK])' - 'RESULT = MINLOC(ARRAY [, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' or 'REAL'. - DIM (Optional) Shall be a scalar of type 'INTEGER', - with a value between one and the rank of ARRAY, - inclusive. It may not be an optional dummy - argument. - MASK Shall be an array of type 'LOGICAL', and - conformable with ARRAY. - -_Return value_: - If DIM is absent, the result is a rank-one array with a length - equal to the rank of ARRAY. If DIM is present, the result is an - array with a rank one less than the rank of ARRAY, and a size - corresponding to the size of ARRAY with the DIM dimension removed. - If DIM is present and ARRAY has a rank of one, the result is a - scalar. In all cases, the result is of default 'INTEGER' type. - -_See also_: - *note MIN::, *note MINVAL:: - - -File: gfortran.info, Node: MINVAL, Next: MOD, Prev: MINLOC, Up: Intrinsic Procedures - -8.176 'MINVAL' -- Minimum value of an array -=========================================== - -_Description_: - Determines the minimum value of the elements in an array value, or, - if the DIM argument is supplied, determines the minimum value along - each row of the array in the DIM direction. If MASK is present, - only the elements for which MASK is '.TRUE.' are considered. If - the array has zero size, or all of the elements of MASK are - '.FALSE.', then the result is 'HUGE(ARRAY)' if ARRAY is numeric, or - a string of 'CHAR(255)' characters if ARRAY is of character type. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = MINVAL(ARRAY, DIM [, MASK])' - 'RESULT = MINVAL(ARRAY [, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER' or 'REAL'. - DIM (Optional) Shall be a scalar of type 'INTEGER', - with a value between one and the rank of ARRAY, - inclusive. It may not be an optional dummy - argument. - MASK Shall be an array of type 'LOGICAL', and - conformable with ARRAY. - -_Return value_: - If DIM is absent, or if ARRAY has a rank of one, the result is a - scalar. If DIM is present, the result is an array with a rank one - less than the rank of ARRAY, and a size corresponding to the size - of ARRAY with the DIM dimension removed. In all cases, the result - is of the same type and kind as ARRAY. - -_See also_: - *note MIN::, *note MINLOC:: - - -File: gfortran.info, Node: MOD, Next: MODULO, Prev: MINVAL, Up: Intrinsic Procedures - -8.177 'MOD' -- Remainder function -================================= - -_Description_: - 'MOD(A,P)' computes the remainder of the division of A by P. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MOD(A, P)' - -_Arguments_: - A Shall be a scalar of type 'INTEGER' or 'REAL'. - P Shall be a scalar of the same type and kind as A - and not equal to zero. - -_Return value_: - The return value is the result of 'A - (INT(A/P) * P)'. The type - and kind of the return value is the same as that of the arguments. - The returned value has the same sign as A and a magnitude less than - the magnitude of P. - -_Example_: - program test_mod - print *, mod(17,3) - print *, mod(17.5,5.5) - print *, mod(17.5d0,5.5) - print *, mod(17.5,5.5d0) - - print *, mod(-17,3) - print *, mod(-17.5,5.5) - print *, mod(-17.5d0,5.5) - print *, mod(-17.5,5.5d0) - - print *, mod(17,-3) - print *, mod(17.5,-5.5) - print *, mod(17.5d0,-5.5) - print *, mod(17.5,-5.5d0) - end program test_mod - -_Specific names_: - Name Arguments Return type Standard - 'MOD(A,P)' 'INTEGER 'INTEGER' Fortran 95 and - A,P' later - 'AMOD(A,P)' 'REAL(4) 'REAL(4)' Fortran 95 and - A,P' later - 'DMOD(A,P)' 'REAL(8) 'REAL(8)' Fortran 95 and - A,P' later - -_See also_: - *note MODULO:: - - -File: gfortran.info, Node: MODULO, Next: MOVE_ALLOC, Prev: MOD, Up: Intrinsic Procedures - -8.178 'MODULO' -- Modulo function -================================= - -_Description_: - 'MODULO(A,P)' computes the A modulo P. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = MODULO(A, P)' - -_Arguments_: - A Shall be a scalar of type 'INTEGER' or 'REAL'. - P Shall be a scalar of the same type and kind as - A. It shall not be zero. - -_Return value_: - The type and kind of the result are those of the arguments. - If A and P are of type 'INTEGER': - 'MODULO(A,P)' has the value R such that 'A=Q*P+R', where Q is - an integer and R is between 0 (inclusive) and P (exclusive). - If A and P are of type 'REAL': - 'MODULO(A,P)' has the value of 'A - FLOOR (A / P) * P'. - The returned value has the same sign as P and a magnitude less than - the magnitude of P. - -_Example_: - program test_modulo - print *, modulo(17,3) - print *, modulo(17.5,5.5) - - print *, modulo(-17,3) - print *, modulo(-17.5,5.5) - - print *, modulo(17,-3) - print *, modulo(17.5,-5.5) - end program - -_See also_: - *note MOD:: - - -File: gfortran.info, Node: MOVE_ALLOC, Next: MVBITS, Prev: MODULO, Up: Intrinsic Procedures - -8.179 'MOVE_ALLOC' -- Move allocation from one object to another -================================================================ - -_Description_: - 'MOVE_ALLOC(FROM, TO)' moves the allocation from FROM to TO. FROM - will become deallocated in the process. - -_Standard_: - Fortran 2003 and later - -_Class_: - Pure subroutine - -_Syntax_: - 'CALL MOVE_ALLOC(FROM, TO)' - -_Arguments_: - FROM 'ALLOCATABLE', 'INTENT(INOUT)', may be of any - type and kind. - TO 'ALLOCATABLE', 'INTENT(OUT)', shall be of the - same type, kind and rank as FROM. - -_Return value_: - None - -_Example_: - program test_move_alloc - integer, allocatable :: a(:), b(:) - - allocate(a(3)) - a = [ 1, 2, 3 ] - call move_alloc(a, b) - print *, allocated(a), allocated(b) - print *, b - end program test_move_alloc - - -File: gfortran.info, Node: MVBITS, Next: NEAREST, Prev: MOVE_ALLOC, Up: Intrinsic Procedures - -8.180 'MVBITS' -- Move bits from one integer to another -======================================================= - -_Description_: - Moves LEN bits from positions FROMPOS through 'FROMPOS+LEN-1' of - FROM to positions TOPOS through 'TOPOS+LEN-1' of TO. The portion - of argument TO not affected by the movement of bits is unchanged. - The values of 'FROMPOS+LEN-1' and 'TOPOS+LEN-1' must be less than - 'BIT_SIZE(FROM)'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental subroutine - -_Syntax_: - 'CALL MVBITS(FROM, FROMPOS, LEN, TO, TOPOS)' - -_Arguments_: - FROM The type shall be 'INTEGER'. - FROMPOS The type shall be 'INTEGER'. - LEN The type shall be 'INTEGER'. - TO The type shall be 'INTEGER', of the same kind as - FROM. - TOPOS The type shall be 'INTEGER'. - -_See also_: - *note IBCLR::, *note IBSET::, *note IBITS::, *note IAND::, *note - IOR::, *note IEOR:: - - -File: gfortran.info, Node: NEAREST, Next: NEW_LINE, Prev: MVBITS, Up: Intrinsic Procedures - -8.181 'NEAREST' -- Nearest representable number -=============================================== - -_Description_: - 'NEAREST(X, S)' returns the processor-representable number nearest - to 'X' in the direction indicated by the sign of 'S'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = NEAREST(X, S)' - -_Arguments_: - X Shall be of type 'REAL'. - S Shall be of type 'REAL' and not equal to zero. - -_Return value_: - The return value is of the same type as 'X'. If 'S' is positive, - 'NEAREST' returns the processor-representable number greater than - 'X' and nearest to it. If 'S' is negative, 'NEAREST' returns the - processor-representable number smaller than 'X' and nearest to it. - -_Example_: - program test_nearest - real :: x, y - x = nearest(42.0, 1.0) - y = nearest(42.0, -1.0) - write (*,"(3(G20.15))") x, y, x - y - end program test_nearest - - -File: gfortran.info, Node: NEW_LINE, Next: NINT, Prev: NEAREST, Up: Intrinsic Procedures - -8.182 'NEW_LINE' -- New line character -====================================== - -_Description_: - 'NEW_LINE(C)' returns the new-line character. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = NEW_LINE(C)' - -_Arguments_: - C The argument shall be a scalar or array of the - type 'CHARACTER'. - -_Return value_: - Returns a CHARACTER scalar of length one with the new-line - character of the same kind as parameter C. - -_Example_: - program newline - implicit none - write(*,'(A)') 'This is record 1.'//NEW_LINE('A')//'This is record 2.' - end program newline - - -File: gfortran.info, Node: NINT, Next: NORM2, Prev: NEW_LINE, Up: Intrinsic Procedures - -8.183 'NINT' -- Nearest whole number -==================================== - -_Description_: - 'NINT(A)' rounds its argument to the nearest whole number. - -_Standard_: - Fortran 77 and later, with KIND argument Fortran 90 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = NINT(A [, KIND])' - -_Arguments_: - A The type of the argument shall be 'REAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - Returns A with the fractional portion of its magnitude eliminated - by rounding to the nearest whole number and with its sign - preserved, converted to an 'INTEGER' of the default kind. - -_Example_: - program test_nint - real(4) x4 - real(8) x8 - x4 = 1.234E0_4 - x8 = 4.321_8 - print *, nint(x4), idnint(x8) - end program test_nint - -_Specific names_: - Name Argument Return Type Standard - 'NINT(A)' 'REAL(4) A' 'INTEGER' Fortran 95 and - later - 'IDNINT(A)' 'REAL(8) A' 'INTEGER' Fortran 95 and - later - -_See also_: - *note CEILING::, *note FLOOR:: - - -File: gfortran.info, Node: NORM2, Next: NOT, Prev: NINT, Up: Intrinsic Procedures - -8.184 'NORM2' -- Euclidean vector norms -======================================= - -_Description_: - Calculates the Euclidean vector norm (L_2 norm) of of ARRAY along - dimension DIM. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = NORM2(ARRAY[, DIM])' - -_Arguments_: - ARRAY Shall be an array of type 'REAL' - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - -_Return value_: - The result is of the same type as ARRAY. - - If DIM is absent, a scalar with the square root of the sum of all - elements in ARRAY squared is returned. Otherwise, an array of rank - n-1, where n equals the rank of ARRAY, and a shape similar to that - of ARRAY with dimension DIM dropped is returned. - -_Example_: - PROGRAM test_sum - REAL :: x(5) = [ real :: 1, 2, 3, 4, 5 ] - print *, NORM2(x) ! = sqrt(55.) ~ 7.416 - END PROGRAM - - -File: gfortran.info, Node: NOT, Next: NULL, Prev: NORM2, Up: Intrinsic Procedures - -8.185 'NOT' -- Logical negation -=============================== - -_Description_: - 'NOT' returns the bitwise Boolean inverse of I. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = NOT(I)' - -_Arguments_: - I The type shall be 'INTEGER'. - -_Return value_: - The return type is 'INTEGER', of the same kind as the argument. - -_See also_: - *note IAND::, *note IEOR::, *note IOR::, *note IBITS::, *note - IBSET::, *note IBCLR:: - - -File: gfortran.info, Node: NULL, Next: NUM_IMAGES, Prev: NOT, Up: Intrinsic Procedures - -8.186 'NULL' -- Function that returns an disassociated pointer -============================================================== - -_Description_: - Returns a disassociated pointer. - - If MOLD is present, a disassociated pointer of the same type is - returned, otherwise the type is determined by context. - - In Fortran 95, MOLD is optional. Please note that Fortran 2003 - includes cases where it is required. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'PTR => NULL([MOLD])' - -_Arguments_: - MOLD (Optional) shall be a pointer of any association - status and of any type. - -_Return value_: - A disassociated pointer. - -_Example_: - REAL, POINTER, DIMENSION(:) :: VEC => NULL () - -_See also_: - *note ASSOCIATED:: - - -File: gfortran.info, Node: NUM_IMAGES, Next: OR, Prev: NULL, Up: Intrinsic Procedures - -8.187 'NUM_IMAGES' -- Function that returns the number of images -================================================================ - -_Description_: - Returns the number of images. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = NUM_IMAGES()' - -_Arguments_: None. - -_Return value_: - Scalar default-kind integer. - -_Example_: - INTEGER :: value[*] - INTEGER :: i - value = THIS_IMAGE() - SYNC ALL - IF (THIS_IMAGE() == 1) THEN - DO i = 1, NUM_IMAGES() - WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i] - END DO - END IF - -_See also_: - *note THIS_IMAGE::, *note IMAGE_INDEX:: - - -File: gfortran.info, Node: OR, Next: PACK, Prev: NUM_IMAGES, Up: Intrinsic Procedures - -8.188 'OR' -- Bitwise logical OR -================================ - -_Description_: - Bitwise logical 'OR'. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. For integer arguments, programmers should consider - the use of the *note IOR:: intrinsic defined by the Fortran - standard. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = OR(I, J)' - -_Arguments_: - I The type shall be either a scalar 'INTEGER' type - or a scalar 'LOGICAL' type. - J The type shall be the same as the type of J. - -_Return value_: - The return type is either a scalar 'INTEGER' or a scalar 'LOGICAL'. - If the kind type parameters differ, then the smaller kind type is - implicitly converted to larger kind, and the return has the larger - kind. - -_Example_: - PROGRAM test_or - LOGICAL :: T = .TRUE., F = .FALSE. - INTEGER :: a, b - DATA a / Z'F' /, b / Z'3' / - - WRITE (*,*) OR(T, T), OR(T, F), OR(F, T), OR(F, F) - WRITE (*,*) OR(a, b) - END PROGRAM - -_See also_: - Fortran 95 elemental function: *note IOR:: - - -File: gfortran.info, Node: PACK, Next: PARITY, Prev: OR, Up: Intrinsic Procedures - -8.189 'PACK' -- Pack an array into an array of rank one -======================================================= - -_Description_: - Stores the elements of ARRAY in an array of rank one. - - The beginning of the resulting array is made up of elements whose - MASK equals 'TRUE'. Afterwards, positions are filled with elements - taken from VECTOR. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = PACK(ARRAY, MASK[,VECTOR])' - -_Arguments_: - ARRAY Shall be an array of any type. - MASK Shall be an array of type 'LOGICAL' and of the - same size as ARRAY. Alternatively, it may be a - 'LOGICAL' scalar. - VECTOR (Optional) shall be an array of the same type as - ARRAY and of rank one. If present, the number - of elements in VECTOR shall be equal to or - greater than the number of true elements in - MASK. If MASK is scalar, the number of elements - in VECTOR shall be equal to or greater than the - number of elements in ARRAY. - -_Return value_: - The result is an array of rank one and the same type as that of - ARRAY. If VECTOR is present, the result size is that of VECTOR, - the number of 'TRUE' values in MASK otherwise. - -_Example_: - Gathering nonzero elements from an array: - PROGRAM test_pack_1 - INTEGER :: m(6) - m = (/ 1, 0, 0, 0, 5, 0 /) - WRITE(*, FMT="(6(I0, ' '))") pack(m, m /= 0) ! "1 5" - END PROGRAM - - Gathering nonzero elements from an array and appending elements - from VECTOR: - PROGRAM test_pack_2 - INTEGER :: m(4) - m = (/ 1, 0, 0, 2 /) - WRITE(*, FMT="(4(I0, ' '))") pack(m, m /= 0, (/ 0, 0, 3, 4 /)) ! "1 2 3 4" - END PROGRAM - -_See also_: - *note UNPACK:: - - -File: gfortran.info, Node: PARITY, Next: PERROR, Prev: PACK, Up: Intrinsic Procedures - -8.190 'PARITY' -- Reduction with exclusive OR -============================================= - -_Description_: - Calculates the parity, i.e. the reduction using '.XOR.', of MASK - along dimension DIM. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = PARITY(MASK[, DIM])' - -_Arguments_: - LOGICAL Shall be an array of type 'LOGICAL' - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of MASK. - -_Return value_: - The result is of the same type as MASK. - - If DIM is absent, a scalar with the parity of all elements in MASK - is returned, i.e. true if an odd number of elements is '.true.' - and false otherwise. If DIM is present, an array of rank n-1, - where n equals the rank of ARRAY, and a shape similar to that of - MASK with dimension DIM dropped is returned. - -_Example_: - PROGRAM test_sum - LOGICAL :: x(2) = [ .true., .false. ] - print *, PARITY(x) ! prints "T" (true). - END PROGRAM - - -File: gfortran.info, Node: PERROR, Next: POPCNT, Prev: PARITY, Up: Intrinsic Procedures - -8.191 'PERROR' -- Print system error message -============================================ - -_Description_: - Prints (on the C 'stderr' stream) a newline-terminated error - message corresponding to the last system error. This is prefixed - by STRING, a colon and a space. See 'perror(3)'. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL PERROR(STRING)' - -_Arguments_: - STRING A scalar of type 'CHARACTER' and of the default - kind. - -_See also_: - *note IERRNO:: - - -File: gfortran.info, Node: POPCNT, Next: POPPAR, Prev: PERROR, Up: Intrinsic Procedures - -8.192 'POPCNT' -- Number of bits set -==================================== - -_Description_: - 'POPCNT(I)' returns the number of bits set ('1' bits) in the binary - representation of 'I'. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = POPCNT(I)' - -_Arguments_: - I Shall be of type 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_See also_: - *note POPPAR::, *note LEADZ::, *note TRAILZ:: - -_Example_: - program test_population - print *, popcnt(127), poppar(127) - print *, popcnt(huge(0_4)), poppar(huge(0_4)) - print *, popcnt(huge(0_8)), poppar(huge(0_8)) - end program test_population - - -File: gfortran.info, Node: POPPAR, Next: PRECISION, Prev: POPCNT, Up: Intrinsic Procedures - -8.193 'POPPAR' -- Parity of the number of bits set -================================================== - -_Description_: - 'POPPAR(I)' returns parity of the integer 'I', i.e. the parity of - the number of bits set ('1' bits) in the binary representation of - 'I'. It is equal to 0 if 'I' has an even number of bits set, and 1 - for an odd number of '1' bits. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = POPPAR(I)' - -_Arguments_: - I Shall be of type 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_See also_: - *note POPCNT::, *note LEADZ::, *note TRAILZ:: - -_Example_: - program test_population - print *, popcnt(127), poppar(127) - print *, popcnt(huge(0_4)), poppar(huge(0_4)) - print *, popcnt(huge(0_8)), poppar(huge(0_8)) - end program test_population - - -File: gfortran.info, Node: PRECISION, Next: PRESENT, Prev: POPPAR, Up: Intrinsic Procedures - -8.194 'PRECISION' -- Decimal precision of a real kind -===================================================== - -_Description_: - 'PRECISION(X)' returns the decimal precision in the model of the - type of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = PRECISION(X)' - -_Arguments_: - X Shall be of type 'REAL' or 'COMPLEX'. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_See also_: - *note SELECTED_REAL_KIND::, *note RANGE:: - -_Example_: - program prec_and_range - real(kind=4) :: x(2) - complex(kind=8) :: y - - print *, precision(x), range(x) - print *, precision(y), range(y) - end program prec_and_range - - -File: gfortran.info, Node: PRESENT, Next: PRODUCT, Prev: PRECISION, Up: Intrinsic Procedures - -8.195 'PRESENT' -- Determine whether an optional dummy argument is specified -============================================================================ - -_Description_: - Determines whether an optional dummy argument is present. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = PRESENT(A)' - -_Arguments_: - A May be of any type and may be a pointer, scalar - or array value, or a dummy procedure. It shall - be the name of an optional dummy argument - accessible within the current subroutine or - function. - -_Return value_: - Returns either 'TRUE' if the optional argument A is present, or - 'FALSE' otherwise. - -_Example_: - PROGRAM test_present - WRITE(*,*) f(), f(42) ! "F T" - CONTAINS - LOGICAL FUNCTION f(x) - INTEGER, INTENT(IN), OPTIONAL :: x - f = PRESENT(x) - END FUNCTION - END PROGRAM - - -File: gfortran.info, Node: PRODUCT, Next: RADIX, Prev: PRESENT, Up: Intrinsic Procedures - -8.196 'PRODUCT' -- Product of array elements -============================================ - -_Description_: - Multiplies the elements of ARRAY along dimension DIM if the - corresponding element in MASK is 'TRUE'. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = PRODUCT(ARRAY[, MASK])' - 'RESULT = PRODUCT(ARRAY, DIM[, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER', 'REAL' or - 'COMPLEX'. - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type 'LOGICAL' and either - be a scalar or an array of the same shape as - ARRAY. - -_Return value_: - The result is of the same type as ARRAY. - - If DIM is absent, a scalar with the product of all elements in - ARRAY is returned. Otherwise, an array of rank n-1, where n equals - the rank of ARRAY, and a shape similar to that of ARRAY with - dimension DIM dropped is returned. - -_Example_: - PROGRAM test_product - INTEGER :: x(5) = (/ 1, 2, 3, 4 ,5 /) - print *, PRODUCT(x) ! all elements, product = 120 - print *, PRODUCT(x, MASK=MOD(x, 2)==1) ! odd elements, product = 15 - END PROGRAM - -_See also_: - *note SUM:: - - -File: gfortran.info, Node: RADIX, Next: RAN, Prev: PRODUCT, Up: Intrinsic Procedures - -8.197 'RADIX' -- Base of a model number -======================================= - -_Description_: - 'RADIX(X)' returns the base of the model representing the entity X. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = RADIX(X)' - -_Arguments_: - X Shall be of type 'INTEGER' or 'REAL' - -_Return value_: - The return value is a scalar of type 'INTEGER' and of the default - integer kind. - -_See also_: - *note SELECTED_REAL_KIND:: - -_Example_: - program test_radix - print *, "The radix for the default integer kind is", radix(0) - print *, "The radix for the default real kind is", radix(0.0) - end program test_radix - - -File: gfortran.info, Node: RAN, Next: RAND, Prev: RADIX, Up: Intrinsic Procedures - -8.198 'RAN' -- Real pseudo-random number -======================================== - -_Description_: - For compatibility with HP FORTRAN 77/iX, the 'RAN' intrinsic is - provided as an alias for 'RAND'. See *note RAND:: for complete - documentation. - -_Standard_: - GNU extension - -_Class_: - Function - -_See also_: - *note RAND::, *note RANDOM_NUMBER:: - - -File: gfortran.info, Node: RAND, Next: RANDOM_NUMBER, Prev: RAN, Up: Intrinsic Procedures - -8.199 'RAND' -- Real pseudo-random number -========================================= - -_Description_: - 'RAND(FLAG)' returns a pseudo-random number from a uniform - distribution between 0 and 1. If FLAG is 0, the next number in the - current sequence is returned; if FLAG is 1, the generator is - restarted by 'CALL SRAND(0)'; if FLAG has any other value, it is - used as a new seed with 'SRAND'. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. It implements a simple modulo generator as - provided by 'g77'. For new code, one should consider the use of - *note RANDOM_NUMBER:: as it implements a superior algorithm. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = RAND(I)' - -_Arguments_: - I Shall be a scalar 'INTEGER' of kind 4. - -_Return value_: - The return value is of 'REAL' type and the default kind. - -_Example_: - program test_rand - integer,parameter :: seed = 86456 - - call srand(seed) - print *, rand(), rand(), rand(), rand() - print *, rand(seed), rand(), rand(), rand() - end program test_rand - -_See also_: - *note SRAND::, *note RANDOM_NUMBER:: - - -File: gfortran.info, Node: RANDOM_NUMBER, Next: RANDOM_SEED, Prev: RAND, Up: Intrinsic Procedures - -8.200 'RANDOM_NUMBER' -- Pseudo-random number -============================================= - -_Description_: - Returns a single pseudorandom number or an array of pseudorandom - numbers from the uniform distribution over the range 0 \leq x < 1. - - The runtime-library implements George Marsaglia's KISS (Keep It - Simple Stupid) random number generator (RNG). This RNG combines: - 1. The congruential generator x(n) = 69069 \cdot x(n-1) + - 1327217885 with a period of 2^{32}, - 2. A 3-shift shift-register generator with a period of 2^{32} - - 1, - 3. Two 16-bit multiply-with-carry generators with a period of - 597273182964842497 > 2^{59}. - The overall period exceeds 2^{123}. - - Please note, this RNG is thread safe if used within OpenMP - directives, i.e., its state will be consistent while called from - multiple threads. However, the KISS generator does not create - random numbers in parallel from multiple sources, but in sequence - from a single source. If an OpenMP-enabled application heavily - relies on random numbers, one should consider employing a dedicated - parallel random number generator instead. - -_Standard_: - Fortran 95 and later - -_Class_: - Subroutine - -_Syntax_: - 'RANDOM_NUMBER(HARVEST)' - -_Arguments_: - HARVEST Shall be a scalar or an array of type 'REAL'. - -_Example_: - program test_random_number - REAL :: r(5,5) - CALL init_random_seed() ! see example of RANDOM_SEED - CALL RANDOM_NUMBER(r) - end program - -_See also_: - *note RANDOM_SEED:: - - -File: gfortran.info, Node: RANDOM_SEED, Next: RANGE, Prev: RANDOM_NUMBER, Up: Intrinsic Procedures - -8.201 'RANDOM_SEED' -- Initialize a pseudo-random number sequence -================================================================= - -_Description_: - Restarts or queries the state of the pseudorandom number generator - used by 'RANDOM_NUMBER'. - - If 'RANDOM_SEED' is called without arguments, it is initialized to - a default state. The example below shows how to initialize the - random seed with a varying seed in order to ensure a different - random number sequence for each invocation of the program. Note - that setting any of the seed values to zero should be avoided as it - can result in poor quality random numbers being generated. - -_Standard_: - Fortran 95 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL RANDOM_SEED([SIZE, PUT, GET])' - -_Arguments_: - SIZE (Optional) Shall be a scalar and of type default - 'INTEGER', with 'INTENT(OUT)'. It specifies the - minimum size of the arrays used with the PUT and - GET arguments. - PUT (Optional) Shall be an array of type default - 'INTEGER' and rank one. It is 'INTENT(IN)' and - the size of the array must be larger than or - equal to the number returned by the SIZE - argument. - GET (Optional) Shall be an array of type default - 'INTEGER' and rank one. It is 'INTENT(OUT)' and - the size of the array must be larger than or - equal to the number returned by the SIZE - argument. - -_Example_: - subroutine init_random_seed() - use iso_fortran_env, only: int64 - implicit none - integer, allocatable :: seed(:) - integer :: i, n, un, istat, dt(8), pid - integer(int64) :: t - - call random_seed(size = n) - allocate(seed(n)) - ! First try if the OS provides a random number generator - open(newunit=un, file="/dev/urandom", access="stream", & - form="unformatted", action="read", status="old", iostat=istat) - if (istat == 0) then - read(un) seed - close(un) - else - ! Fallback to XOR:ing the current time and pid. The PID is - ! useful in case one launches multiple instances of the same - ! program in parallel. - call system_clock(t) - if (t == 0) then - call date_and_time(values=dt) - t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 & - + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 & - + dt(3) * 24_int64 * 60 * 60 * 1000 & - + dt(5) * 60 * 60 * 1000 & - + dt(6) * 60 * 1000 + dt(7) * 1000 & - + dt(8) - end if - pid = getpid() - t = ieor(t, int(pid, kind(t))) - do i = 1, n - seed(i) = lcg(t) - end do - end if - call random_seed(put=seed) - contains - ! This simple PRNG might not be good enough for real work, but is - ! sufficient for seeding a better PRNG. - function lcg(s) - integer :: lcg - integer(int64) :: s - if (s == 0) then - s = 104729 - else - s = mod(s, 4294967296_int64) - end if - s = mod(s * 279470273_int64, 4294967291_int64) - lcg = int(mod(s, int(huge(0), int64)), kind(0)) - end function lcg - end subroutine init_random_seed - -_See also_: - *note RANDOM_NUMBER:: - - -File: gfortran.info, Node: RANGE, Next: RANK, Prev: RANDOM_SEED, Up: Intrinsic Procedures - -8.202 'RANGE' -- Decimal exponent range -======================================= - -_Description_: - 'RANGE(X)' returns the decimal exponent range in the model of the - type of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = RANGE(X)' - -_Arguments_: - X Shall be of type 'INTEGER', 'REAL' or 'COMPLEX'. - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. - -_See also_: - *note SELECTED_REAL_KIND::, *note PRECISION:: - -_Example_: - See 'PRECISION' for an example. - - -File: gfortran.info, Node: RANK, Next: REAL, Prev: RANGE, Up: Intrinsic Procedures - -8.203 'RANK' -- Rank of a data object -===================================== - -_Description_: - 'RANK(A)' returns the rank of a scalar or array data object. - -_Standard_: - Technical Specification (TS) 29113 - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = RANK(A)' - -_Arguments_: - A can be of any type - -_Return value_: - The return value is of type 'INTEGER' and of the default integer - kind. For arrays, their rank is returned; for scalars zero is - returned. - -_Example_: - program test_rank - integer :: a - real, allocatable :: b(:,:) - - print *, rank(a), rank(b) ! Prints: 0 2 - end program test_rank - - -File: gfortran.info, Node: REAL, Next: RENAME, Prev: RANK, Up: Intrinsic Procedures - -8.204 'REAL' -- Convert to real type -==================================== - -_Description_: - 'REAL(A [, KIND])' converts its argument A to a real type. The - 'REALPART' function is provided for compatibility with 'g77', and - its use is strongly discouraged. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = REAL(A [, KIND])' - 'RESULT = REALPART(Z)' - -_Arguments_: - A Shall be 'INTEGER', 'REAL', or 'COMPLEX'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - These functions return a 'REAL' variable or array under the - following rules: - - (A) - 'REAL(A)' is converted to a default real type if A is an - integer or real variable. - (B) - 'REAL(A)' is converted to a real type with the kind type - parameter of A if A is a complex variable. - (C) - 'REAL(A, KIND)' is converted to a real type with kind type - parameter KIND if A is a complex, integer, or real variable. - -_Example_: - program test_real - complex :: x = (1.0, 2.0) - print *, real(x), real(x,8), realpart(x) - end program test_real - -_Specific names_: - Name Argument Return type Standard - 'FLOAT(A)' 'INTEGER(4)' 'REAL(4)' Fortran 77 and - later - 'DFLOAT(A)' 'INTEGER(4)' 'REAL(8)' GNU extension - 'SNGL(A)' 'INTEGER(8)' 'REAL(4)' Fortran 77 and - later - -_See also_: - *note DBLE:: - - -File: gfortran.info, Node: RENAME, Next: REPEAT, Prev: REAL, Up: Intrinsic Procedures - -8.205 'RENAME' -- Rename a file -=============================== - -_Description_: - Renames a file from file PATH1 to PATH2. A null character - ('CHAR(0)') can be used to mark the end of the names in PATH1 and - PATH2; otherwise, trailing blanks in the file names are ignored. - If the STATUS argument is supplied, it contains 0 on success or a - nonzero error code upon return; see 'rename(2)'. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL RENAME(PATH1, PATH2 [, STATUS])' - 'STATUS = RENAME(PATH1, PATH2)' - -_Arguments_: - PATH1 Shall be of default 'CHARACTER' type. - PATH2 Shall be of default 'CHARACTER' type. - STATUS (Optional) Shall be of default 'INTEGER' type. - -_See also_: - *note LINK:: - - -File: gfortran.info, Node: REPEAT, Next: RESHAPE, Prev: RENAME, Up: Intrinsic Procedures - -8.206 'REPEAT' -- Repeated string concatenation -=============================================== - -_Description_: - Concatenates NCOPIES copies of a string. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = REPEAT(STRING, NCOPIES)' - -_Arguments_: - STRING Shall be scalar and of type 'CHARACTER'. - NCOPIES Shall be scalar and of type 'INTEGER'. - -_Return value_: - A new scalar of type 'CHARACTER' built up from NCOPIES copies of - STRING. - -_Example_: - program test_repeat - write(*,*) repeat("x", 5) ! "xxxxx" - end program - - -File: gfortran.info, Node: RESHAPE, Next: RRSPACING, Prev: REPEAT, Up: Intrinsic Procedures - -8.207 'RESHAPE' -- Function to reshape an array -=============================================== - -_Description_: - Reshapes SOURCE to correspond to SHAPE. If necessary, the new - array may be padded with elements from PAD or permuted as defined - by ORDER. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = RESHAPE(SOURCE, SHAPE[, PAD, ORDER])' - -_Arguments_: - SOURCE Shall be an array of any type. - SHAPE Shall be of type 'INTEGER' and an array of rank - one. Its values must be positive or zero. - PAD (Optional) shall be an array of the same type as - SOURCE. - ORDER (Optional) shall be of type 'INTEGER' and an - array of the same shape as SHAPE. Its values - shall be a permutation of the numbers from 1 to - n, where n is the size of SHAPE. If ORDER is - absent, the natural ordering shall be assumed. - -_Return value_: - The result is an array of shape SHAPE with the same type as SOURCE. - -_Example_: - PROGRAM test_reshape - INTEGER, DIMENSION(4) :: x - WRITE(*,*) SHAPE(x) ! prints "4" - WRITE(*,*) SHAPE(RESHAPE(x, (/2, 2/))) ! prints "2 2" - END PROGRAM - -_See also_: - *note SHAPE:: - - -File: gfortran.info, Node: RRSPACING, Next: RSHIFT, Prev: RESHAPE, Up: Intrinsic Procedures - -8.208 'RRSPACING' -- Reciprocal of the relative spacing -======================================================= - -_Description_: - 'RRSPACING(X)' returns the reciprocal of the relative spacing of - model numbers near X. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = RRSPACING(X)' - -_Arguments_: - X Shall be of type 'REAL'. - -_Return value_: - The return value is of the same type and kind as X. The value - returned is equal to 'ABS(FRACTION(X)) * - FLOAT(RADIX(X))**DIGITS(X)'. - -_See also_: - *note SPACING:: - - -File: gfortran.info, Node: RSHIFT, Next: SAME_TYPE_AS, Prev: RRSPACING, Up: Intrinsic Procedures - -8.209 'RSHIFT' -- Right shift bits -================================== - -_Description_: - 'RSHIFT' returns a value corresponding to I with all of the bits - shifted right by SHIFT places. If the absolute value of SHIFT is - greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted - out from the right end are lost. The fill is arithmetic: the bits - shifted in from the left end are equal to the leftmost bit, which - in two's complement representation is the sign bit. - - This function has been superseded by the 'SHIFTA' intrinsic, which - is standard in Fortran 2008 and later. - -_Standard_: - GNU extension - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = RSHIFT(I, SHIFT)' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note ISHFT::, *note ISHFTC::, *note LSHIFT::, *note SHIFTA::, - *note SHIFTR::, *note SHIFTL:: - - -File: gfortran.info, Node: SAME_TYPE_AS, Next: SCALE, Prev: RSHIFT, Up: Intrinsic Procedures - -8.210 'SAME_TYPE_AS' -- Query dynamic types for equality -======================================================== - -_Description_: - Query dynamic types for equality. - -_Standard_: - Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = SAME_TYPE_AS(A, B)' - -_Arguments_: - A Shall be an object of extensible declared type - or unlimited polymorphic. - B Shall be an object of extensible declared type - or unlimited polymorphic. - -_Return value_: - The return value is a scalar of type default logical. It is true - if and only if the dynamic type of A is the same as the dynamic - type of B. - -_See also_: - *note EXTENDS_TYPE_OF:: - - -File: gfortran.info, Node: SCALE, Next: SCAN, Prev: SAME_TYPE_AS, Up: Intrinsic Procedures - -8.211 'SCALE' -- Scale a real value -=================================== - -_Description_: - 'SCALE(X,I)' returns 'X * RADIX(X)**I'. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SCALE(X, I)' - -_Arguments_: - X The type of the argument shall be a 'REAL'. - I The type of the argument shall be a 'INTEGER'. - -_Return value_: - The return value is of the same type and kind as X. Its value is - 'X * RADIX(X)**I'. - -_Example_: - program test_scale - real :: x = 178.1387e-4 - integer :: i = 5 - print *, scale(x,i), x*radix(x)**i - end program test_scale - - -File: gfortran.info, Node: SCAN, Next: SECNDS, Prev: SCALE, Up: Intrinsic Procedures - -8.212 'SCAN' -- Scan a string for the presence of a set of characters -===================================================================== - -_Description_: - Scans a STRING for any of the characters in a SET of characters. - - If BACK is either absent or equals 'FALSE', this function returns - the position of the leftmost character of STRING that is in SET. - If BACK equals 'TRUE', the rightmost position is returned. If no - character of SET is found in STRING, the result is zero. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SCAN(STRING, SET[, BACK [, KIND]])' - -_Arguments_: - STRING Shall be of type 'CHARACTER'. - SET Shall be of type 'CHARACTER'. - BACK (Optional) shall be of type 'LOGICAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Example_: - PROGRAM test_scan - WRITE(*,*) SCAN("FORTRAN", "AO") ! 2, found 'O' - WRITE(*,*) SCAN("FORTRAN", "AO", .TRUE.) ! 6, found 'A' - WRITE(*,*) SCAN("FORTRAN", "C++") ! 0, found none - END PROGRAM - -_See also_: - *note INDEX intrinsic::, *note VERIFY:: - - -File: gfortran.info, Node: SECNDS, Next: SECOND, Prev: SCAN, Up: Intrinsic Procedures - -8.213 'SECNDS' -- Time function -=============================== - -_Description_: - 'SECNDS(X)' gets the time in seconds from the real-time system - clock. X is a reference time, also in seconds. If this is zero, - the time in seconds from midnight is returned. This function is - non-standard and its use is discouraged. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = SECNDS (X)' - -_Arguments_: - T Shall be of type 'REAL(4)'. - X Shall be of type 'REAL(4)'. - -_Return value_: - None - -_Example_: - program test_secnds - integer :: i - real(4) :: t1, t2 - print *, secnds (0.0) ! seconds since midnight - t1 = secnds (0.0) ! reference time - do i = 1, 10000000 ! do something - end do - t2 = secnds (t1) ! elapsed time - print *, "Something took ", t2, " seconds." - end program test_secnds - - -File: gfortran.info, Node: SECOND, Next: SELECTED_CHAR_KIND, Prev: SECNDS, Up: Intrinsic Procedures - -8.214 'SECOND' -- CPU time function -=================================== - -_Description_: - Returns a 'REAL(4)' value representing the elapsed CPU time in - seconds. This provides the same functionality as the standard - 'CPU_TIME' intrinsic, and is only included for backwards - compatibility. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL SECOND(TIME)' - 'TIME = SECOND()' - -_Arguments_: - TIME Shall be of type 'REAL(4)'. - -_Return value_: - In either syntax, TIME is set to the process's current runtime in - seconds. - -_See also_: - *note CPU_TIME:: - - -File: gfortran.info, Node: SELECTED_CHAR_KIND, Next: SELECTED_INT_KIND, Prev: SECOND, Up: Intrinsic Procedures - -8.215 'SELECTED_CHAR_KIND' -- Choose character kind -=================================================== - -_Description_: - - 'SELECTED_CHAR_KIND(NAME)' returns the kind value for the character - set named NAME, if a character set with such a name is supported, - or -1 otherwise. Currently, supported character sets include - "ASCII" and "DEFAULT", which are equivalent, and "ISO_10646" - (Universal Character Set, UCS-4) which is commonly known as - Unicode. - -_Standard_: - Fortran 2003 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = SELECTED_CHAR_KIND(NAME)' - -_Arguments_: - NAME Shall be a scalar and of the default character - type. - -_Example_: - program character_kind - use iso_fortran_env - implicit none - integer, parameter :: ascii = selected_char_kind ("ascii") - integer, parameter :: ucs4 = selected_char_kind ('ISO_10646') - - character(kind=ascii, len=26) :: alphabet - character(kind=ucs4, len=30) :: hello_world - - alphabet = ascii_"abcdefghijklmnopqrstuvwxyz" - hello_world = ucs4_'Hello World and Ni Hao -- ' & - // char (int (z'4F60'), ucs4) & - // char (int (z'597D'), ucs4) - - write (*,*) alphabet - - open (output_unit, encoding='UTF-8') - write (*,*) trim (hello_world) - end program character_kind - - -File: gfortran.info, Node: SELECTED_INT_KIND, Next: SELECTED_REAL_KIND, Prev: SELECTED_CHAR_KIND, Up: Intrinsic Procedures - -8.216 'SELECTED_INT_KIND' -- Choose integer kind -================================================ - -_Description_: - 'SELECTED_INT_KIND(R)' return the kind value of the smallest - integer type that can represent all values ranging from -10^R - (exclusive) to 10^R (exclusive). If there is no integer kind that - accommodates this range, 'SELECTED_INT_KIND' returns -1. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = SELECTED_INT_KIND(R)' - -_Arguments_: - R Shall be a scalar and of type 'INTEGER'. - -_Example_: - program large_integers - integer,parameter :: k5 = selected_int_kind(5) - integer,parameter :: k15 = selected_int_kind(15) - integer(kind=k5) :: i5 - integer(kind=k15) :: i15 - - print *, huge(i5), huge(i15) - - ! The following inequalities are always true - print *, huge(i5) >= 10_k5**5-1 - print *, huge(i15) >= 10_k15**15-1 - end program large_integers - - -File: gfortran.info, Node: SELECTED_REAL_KIND, Next: SET_EXPONENT, Prev: SELECTED_INT_KIND, Up: Intrinsic Procedures - -8.217 'SELECTED_REAL_KIND' -- Choose real kind -============================================== - -_Description_: - 'SELECTED_REAL_KIND(P,R)' returns the kind value of a real data - type with decimal precision of at least 'P' digits, exponent range - of at least 'R', and with a radix of 'RADIX'. - -_Standard_: - Fortran 95 and later, with 'RADIX' Fortran 2008 or later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = SELECTED_REAL_KIND([P, R, RADIX])' - -_Arguments_: - P (Optional) shall be a scalar and of type - 'INTEGER'. - R (Optional) shall be a scalar and of type - 'INTEGER'. - RADIX (Optional) shall be a scalar and of type - 'INTEGER'. - Before Fortran 2008, at least one of the arguments R or P shall be - present; since Fortran 2008, they are assumed to be zero if absent. - -_Return value_: - - 'SELECTED_REAL_KIND' returns the value of the kind type parameter - of a real data type with decimal precision of at least 'P' digits, - a decimal exponent range of at least 'R', and with the requested - 'RADIX'. If the 'RADIX' parameter is absent, real kinds with any - radix can be returned. If more than one real data type meet the - criteria, the kind of the data type with the smallest decimal - precision is returned. If no real data type matches the criteria, - the result is - -1 if the processor does not support a real data type with a - precision greater than or equal to 'P', but the 'R' and - 'RADIX' requirements can be fulfilled - -2 if the processor does not support a real type with an exponent - range greater than or equal to 'R', but 'P' and 'RADIX' are - fulfillable - -3 if 'RADIX' but not 'P' and 'R' requirements - are fulfillable - -4 if 'RADIX' and either 'P' or 'R' requirements - are fulfillable - -5 if there is no real type with the given 'RADIX' - -_See also_: - *note PRECISION::, *note RANGE::, *note RADIX:: - -_Example_: - program real_kinds - integer,parameter :: p6 = selected_real_kind(6) - integer,parameter :: p10r100 = selected_real_kind(10,100) - integer,parameter :: r400 = selected_real_kind(r=400) - real(kind=p6) :: x - real(kind=p10r100) :: y - real(kind=r400) :: z - - print *, precision(x), range(x) - print *, precision(y), range(y) - print *, precision(z), range(z) - end program real_kinds - - -File: gfortran.info, Node: SET_EXPONENT, Next: SHAPE, Prev: SELECTED_REAL_KIND, Up: Intrinsic Procedures - -8.218 'SET_EXPONENT' -- Set the exponent of the model -===================================================== - -_Description_: - 'SET_EXPONENT(X, I)' returns the real number whose fractional part - is that that of X and whose exponent part is I. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SET_EXPONENT(X, I)' - -_Arguments_: - X Shall be of type 'REAL'. - I Shall be of type 'INTEGER'. - -_Return value_: - The return value is of the same type and kind as X. The real - number whose fractional part is that that of X and whose exponent - part if I is returned; it is 'FRACTION(X) * RADIX(X)**I'. - -_Example_: - PROGRAM test_setexp - REAL :: x = 178.1387e-4 - INTEGER :: i = 17 - PRINT *, SET_EXPONENT(x, i), FRACTION(x) * RADIX(x)**i - END PROGRAM - - -File: gfortran.info, Node: SHAPE, Next: SHIFTA, Prev: SET_EXPONENT, Up: Intrinsic Procedures - -8.219 'SHAPE' -- Determine the shape of an array -================================================ - -_Description_: - Determines the shape of an array. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = SHAPE(SOURCE [, KIND])' - -_Arguments_: - SOURCE Shall be an array or scalar of any type. If - SOURCE is a pointer it must be associated and - allocatable arrays must be allocated. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - An 'INTEGER' array of rank one with as many elements as SOURCE has - dimensions. The elements of the resulting array correspond to the - extend of SOURCE along the respective dimensions. If SOURCE is a - scalar, the result is the rank one array of size zero. If KIND is - absent, the return value has the default integer kind otherwise the - specified kind. - -_Example_: - PROGRAM test_shape - INTEGER, DIMENSION(-1:1, -1:2) :: A - WRITE(*,*) SHAPE(A) ! (/ 3, 4 /) - WRITE(*,*) SIZE(SHAPE(42)) ! (/ /) - END PROGRAM - -_See also_: - *note RESHAPE::, *note SIZE:: - - -File: gfortran.info, Node: SHIFTA, Next: SHIFTL, Prev: SHAPE, Up: Intrinsic Procedures - -8.220 'SHIFTA' -- Right shift with fill -======================================= - -_Description_: - 'SHIFTA' returns a value corresponding to I with all of the bits - shifted right by SHIFT places. If the absolute value of SHIFT is - greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted - out from the right end are lost. The fill is arithmetic: the bits - shifted in from the left end are equal to the leftmost bit, which - in two's complement representation is the sign bit. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SHIFTA(I, SHIFT)' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note SHIFTL::, *note SHIFTR:: - - -File: gfortran.info, Node: SHIFTL, Next: SHIFTR, Prev: SHIFTA, Up: Intrinsic Procedures - -8.221 'SHIFTL' -- Left shift -============================ - -_Description_: - 'SHIFTL' returns a value corresponding to I with all of the bits - shifted left by SHIFT places. If the absolute value of SHIFT is - greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted - out from the left end are lost, and bits shifted in from the right - end are set to 0. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SHIFTL(I, SHIFT)' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note SHIFTA::, *note SHIFTR:: - - -File: gfortran.info, Node: SHIFTR, Next: SIGN, Prev: SHIFTL, Up: Intrinsic Procedures - -8.222 'SHIFTR' -- Right shift -============================= - -_Description_: - 'SHIFTR' returns a value corresponding to I with all of the bits - shifted right by SHIFT places. If the absolute value of SHIFT is - greater than 'BIT_SIZE(I)', the value is undefined. Bits shifted - out from the right end are lost, and bits shifted in from the left - end are set to 0. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SHIFTR(I, SHIFT)' - -_Arguments_: - I The type shall be 'INTEGER'. - SHIFT The type shall be 'INTEGER'. - -_Return value_: - The return value is of type 'INTEGER' and of the same kind as I. - -_See also_: - *note SHIFTA::, *note SHIFTL:: - - -File: gfortran.info, Node: SIGN, Next: SIGNAL, Prev: SHIFTR, Up: Intrinsic Procedures - -8.223 'SIGN' -- Sign copying function -===================================== - -_Description_: - 'SIGN(A,B)' returns the value of A with the sign of B. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SIGN(A, B)' - -_Arguments_: - A Shall be of type 'INTEGER' or 'REAL' - B Shall be of the same type and kind as A - -_Return value_: - The kind of the return value is that of A and B. If B\ge 0 then - the result is 'ABS(A)', else it is '-ABS(A)'. - -_Example_: - program test_sign - print *, sign(-12,1) - print *, sign(-12,0) - print *, sign(-12,-1) - - print *, sign(-12.,1.) - print *, sign(-12.,0.) - print *, sign(-12.,-1.) - end program test_sign - -_Specific names_: - Name Arguments Return type Standard - 'SIGN(A,B)' 'REAL(4) A, 'REAL(4)' f77, gnu - B' - 'ISIGN(A,B)' 'INTEGER(4) 'INTEGER(4)' f77, gnu - A, B' - 'DSIGN(A,B)' 'REAL(8) A, 'REAL(8)' f77, gnu - B' - - -File: gfortran.info, Node: SIGNAL, Next: SIN, Prev: SIGN, Up: Intrinsic Procedures - -8.224 'SIGNAL' -- Signal handling subroutine (or function) -========================================================== - -_Description_: - 'SIGNAL(NUMBER, HANDLER [, STATUS])' causes external subroutine - HANDLER to be executed with a single integer argument when signal - NUMBER occurs. If HANDLER is an integer, it can be used to turn - off handling of signal NUMBER or revert to its default action. See - 'signal(2)'. - - If 'SIGNAL' is called as a subroutine and the STATUS argument is - supplied, it is set to the value returned by 'signal(2)'. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL SIGNAL(NUMBER, HANDLER [, STATUS])' - 'STATUS = SIGNAL(NUMBER, HANDLER)' - -_Arguments_: - NUMBER Shall be a scalar integer, with 'INTENT(IN)' - HANDLER Signal handler ('INTEGER FUNCTION' or - 'SUBROUTINE') or dummy/global 'INTEGER' scalar. - 'INTEGER'. It is 'INTENT(IN)'. - STATUS (Optional) STATUS shall be a scalar integer. It - has 'INTENT(OUT)'. - -_Return value_: - The 'SIGNAL' function returns the value returned by 'signal(2)'. - -_Example_: - program test_signal - intrinsic signal - external handler_print - - call signal (12, handler_print) - call signal (10, 1) - - call sleep (30) - end program test_signal - - -File: gfortran.info, Node: SIN, Next: SINH, Prev: SIGNAL, Up: Intrinsic Procedures - -8.225 'SIN' -- Sine function -============================ - -_Description_: - 'SIN(X)' computes the sine of X. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SIN(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. - -_Example_: - program test_sin - real :: x = 0.0 - x = sin(x) - end program test_sin - -_Specific names_: - Name Argument Return type Standard - 'SIN(X)' 'REAL(4) X' 'REAL(4)' f77, gnu - 'DSIN(X)' 'REAL(8) X' 'REAL(8)' f95, gnu - 'CSIN(X)' 'COMPLEX(4) 'COMPLEX(4)' f95, gnu - X' - 'ZSIN(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu - X' - 'CDSIN(X)' 'COMPLEX(8) 'COMPLEX(8)' f95, gnu - X' - -_See also_: - *note ASIN:: - - -File: gfortran.info, Node: SINH, Next: SIZE, Prev: SIN, Up: Intrinsic Procedures - -8.226 'SINH' -- Hyperbolic sine function -======================================== - -_Description_: - 'SINH(X)' computes the hyperbolic sine of X. - -_Standard_: - Fortran 95 and later, for a complex argument Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SINH(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. - -_Example_: - program test_sinh - real(8) :: x = - 1.0_8 - x = sinh(x) - end program test_sinh - -_Specific names_: - Name Argument Return type Standard - 'SINH(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and - later - 'DSINH(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and - later - -_See also_: - *note ASINH:: - - -File: gfortran.info, Node: SIZE, Next: SIZEOF, Prev: SINH, Up: Intrinsic Procedures - -8.227 'SIZE' -- Determine the size of an array -============================================== - -_Description_: - Determine the extent of ARRAY along a specified dimension DIM, or - the total number of elements in ARRAY if DIM is absent. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = SIZE(ARRAY[, DIM [, KIND]])' - -_Arguments_: - ARRAY Shall be an array of any type. If ARRAY is a - pointer it must be associated and allocatable - arrays must be allocated. - DIM (Optional) shall be a scalar of type 'INTEGER' - and its value shall be in the range from 1 to n, - where n equals the rank of ARRAY. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Example_: - PROGRAM test_size - WRITE(*,*) SIZE((/ 1, 2 /)) ! 2 - END PROGRAM - -_See also_: - *note SHAPE::, *note RESHAPE:: - - -File: gfortran.info, Node: SIZEOF, Next: SLEEP, Prev: SIZE, Up: Intrinsic Procedures - -8.228 'SIZEOF' -- Size in bytes of an expression -================================================ - -_Description_: - 'SIZEOF(X)' calculates the number of bytes of storage the - expression 'X' occupies. - -_Standard_: - GNU extension - -_Class_: - Inquiry function - -_Syntax_: - 'N = SIZEOF(X)' - -_Arguments_: - X The argument shall be of any type, rank or - shape. - -_Return value_: - The return value is of type integer and of the system-dependent - kind C_SIZE_T (from the ISO_C_BINDING module). Its value is the - number of bytes occupied by the argument. If the argument has the - 'POINTER' attribute, the number of bytes of the storage area - pointed to is returned. If the argument is of a derived type with - 'POINTER' or 'ALLOCATABLE' components, the return value does not - account for the sizes of the data pointed to by these components. - If the argument is polymorphic, the size according to the declared - type is returned. The argument may not be a procedure or procedure - pointer. - -_Example_: - integer :: i - real :: r, s(5) - print *, (sizeof(s)/sizeof(r) == 5) - end - The example will print '.TRUE.' unless you are using a platform - where default 'REAL' variables are unusually padded. - -_See also_: - *note C_SIZEOF::, *note STORAGE_SIZE:: - - -File: gfortran.info, Node: SLEEP, Next: SPACING, Prev: SIZEOF, Up: Intrinsic Procedures - -8.229 'SLEEP' -- Sleep for the specified number of seconds -========================================================== - -_Description_: - Calling this subroutine causes the process to pause for SECONDS - seconds. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL SLEEP(SECONDS)' - -_Arguments_: - SECONDS The type shall be of default 'INTEGER'. - -_Example_: - program test_sleep - call sleep(5) - end - - -File: gfortran.info, Node: SPACING, Next: SPREAD, Prev: SLEEP, Up: Intrinsic Procedures - -8.230 'SPACING' -- Smallest distance between two numbers of a given type -======================================================================== - -_Description_: - Determines the distance between the argument X and the nearest - adjacent number of the same type. - -_Standard_: - Fortran 95 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SPACING(X)' - -_Arguments_: - X Shall be of type 'REAL'. - -_Return value_: - The result is of the same type as the input argument X. - -_Example_: - PROGRAM test_spacing - INTEGER, PARAMETER :: SGL = SELECTED_REAL_KIND(p=6, r=37) - INTEGER, PARAMETER :: DBL = SELECTED_REAL_KIND(p=13, r=200) - - WRITE(*,*) spacing(1.0_SGL) ! "1.1920929E-07" on i686 - WRITE(*,*) spacing(1.0_DBL) ! "2.220446049250313E-016" on i686 - END PROGRAM - -_See also_: - *note RRSPACING:: - - -File: gfortran.info, Node: SPREAD, Next: SQRT, Prev: SPACING, Up: Intrinsic Procedures - -8.231 'SPREAD' -- Add a dimension to an array -============================================= - -_Description_: - Replicates a SOURCE array NCOPIES times along a specified dimension - DIM. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = SPREAD(SOURCE, DIM, NCOPIES)' - -_Arguments_: - SOURCE Shall be a scalar or an array of any type and a - rank less than seven. - DIM Shall be a scalar of type 'INTEGER' with a value - in the range from 1 to n+1, where n equals the - rank of SOURCE. - NCOPIES Shall be a scalar of type 'INTEGER'. - -_Return value_: - The result is an array of the same type as SOURCE and has rank n+1 - where n equals the rank of SOURCE. - -_Example_: - PROGRAM test_spread - INTEGER :: a = 1, b(2) = (/ 1, 2 /) - WRITE(*,*) SPREAD(A, 1, 2) ! "1 1" - WRITE(*,*) SPREAD(B, 1, 2) ! "1 1 2 2" - END PROGRAM - -_See also_: - *note UNPACK:: - - -File: gfortran.info, Node: SQRT, Next: SRAND, Prev: SPREAD, Up: Intrinsic Procedures - -8.232 'SQRT' -- Square-root function -==================================== - -_Description_: - 'SQRT(X)' computes the square root of X. - -_Standard_: - Fortran 77 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = SQRT(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value is of type 'REAL' or 'COMPLEX'. The kind type - parameter is the same as X. - -_Example_: - program test_sqrt - real(8) :: x = 2.0_8 - complex :: z = (1.0, 2.0) - x = sqrt(x) - z = sqrt(z) - end program test_sqrt - -_Specific names_: - Name Argument Return type Standard - 'SQRT(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and - later - 'DSQRT(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and - later - 'CSQRT(X)' 'COMPLEX(4) 'COMPLEX(4)' Fortran 95 and - X' later - 'ZSQRT(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - X' - 'CDSQRT(X)' 'COMPLEX(8) 'COMPLEX(8)' GNU extension - X' - - -File: gfortran.info, Node: SRAND, Next: STAT, Prev: SQRT, Up: Intrinsic Procedures - -8.233 'SRAND' -- Reinitialize the random number generator -========================================================= - -_Description_: - 'SRAND' reinitializes the pseudo-random number generator called by - 'RAND' and 'IRAND'. The new seed used by the generator is - specified by the required argument SEED. - -_Standard_: - GNU extension - -_Class_: - Subroutine - -_Syntax_: - 'CALL SRAND(SEED)' - -_Arguments_: - SEED Shall be a scalar 'INTEGER(kind=4)'. - -_Return value_: - Does not return anything. - -_Example_: - See 'RAND' and 'IRAND' for examples. - -_Notes_: - The Fortran 2003 standard specifies the intrinsic 'RANDOM_SEED' to - initialize the pseudo-random numbers generator and 'RANDOM_NUMBER' - to generate pseudo-random numbers. Please note that in GNU - Fortran, these two sets of intrinsics ('RAND', 'IRAND' and 'SRAND' - on the one hand, 'RANDOM_NUMBER' and 'RANDOM_SEED' on the other - hand) access two independent pseudo-random number generators. - -_See also_: - *note RAND::, *note RANDOM_SEED::, *note RANDOM_NUMBER:: - - -File: gfortran.info, Node: STAT, Next: STORAGE_SIZE, Prev: SRAND, Up: Intrinsic Procedures - -8.234 'STAT' -- Get file status -=============================== - -_Description_: - This function returns information about a file. No permissions are - required on the file itself, but execute (search) permission is - required on all of the directories in path that lead to the file. - - The elements that are obtained and stored in the array 'VALUES': - 'VALUES(1)' Device ID - 'VALUES(2)' Inode number - 'VALUES(3)' File mode - 'VALUES(4)' Number of links - 'VALUES(5)' Owner's uid - 'VALUES(6)' Owner's gid - 'VALUES(7)' ID of device containing directory entry for file - (0 if not available) - 'VALUES(8)' File size (bytes) - 'VALUES(9)' Last access time - 'VALUES(10)'Last modification time - 'VALUES(11)'Last file status change time - 'VALUES(12)'Preferred I/O block size (-1 if not available) - 'VALUES(13)'Number of blocks allocated (-1 if not available) - - Not all these elements are relevant on all systems. If an element - is not relevant, it is returned as 0. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL STAT(NAME, VALUES [, STATUS])' - 'STATUS = STAT(NAME, VALUES)' - -_Arguments_: - NAME The type shall be 'CHARACTER', of the default - kind and a valid path within the file system. - VALUES The type shall be 'INTEGER(4), DIMENSION(13)'. - STATUS (Optional) status flag of type 'INTEGER(4)'. - Returns 0 on success and a system specific error - code otherwise. - -_Example_: - PROGRAM test_stat - INTEGER, DIMENSION(13) :: buff - INTEGER :: status - - CALL STAT("/etc/passwd", buff, status) - - IF (status == 0) THEN - WRITE (*, FMT="('Device ID:', T30, I19)") buff(1) - WRITE (*, FMT="('Inode number:', T30, I19)") buff(2) - WRITE (*, FMT="('File mode (octal):', T30, O19)") buff(3) - WRITE (*, FMT="('Number of links:', T30, I19)") buff(4) - WRITE (*, FMT="('Owner''s uid:', T30, I19)") buff(5) - WRITE (*, FMT="('Owner''s gid:', T30, I19)") buff(6) - WRITE (*, FMT="('Device where located:', T30, I19)") buff(7) - WRITE (*, FMT="('File size:', T30, I19)") buff(8) - WRITE (*, FMT="('Last access time:', T30, A19)") CTIME(buff(9)) - WRITE (*, FMT="('Last modification time', T30, A19)") CTIME(buff(10)) - WRITE (*, FMT="('Last status change time:', T30, A19)") CTIME(buff(11)) - WRITE (*, FMT="('Preferred block size:', T30, I19)") buff(12) - WRITE (*, FMT="('No. of blocks allocated:', T30, I19)") buff(13) - END IF - END PROGRAM - -_See also_: - To stat an open file: *note FSTAT::, to stat a link: *note LSTAT:: - - -File: gfortran.info, Node: STORAGE_SIZE, Next: SUM, Prev: STAT, Up: Intrinsic Procedures - -8.235 'STORAGE_SIZE' -- Storage size in bits -============================================ - -_Description_: - Returns the storage size of argument A in bits. -_Standard_: - Fortran 2008 and later -_Class_: - Inquiry function -_Syntax_: - 'RESULT = STORAGE_SIZE(A [, KIND])' - -_Arguments_: - A Shall be a scalar or array of any type. - KIND (Optional) shall be a scalar integer constant - expression. - -_Return Value_: - The result is a scalar integer with the kind type parameter - specified by KIND (or default integer type if KIND is missing). - The result value is the size expressed in bits for an element of an - array that has the dynamic type and type parameters of A. - -_See also_: - *note C_SIZEOF::, *note SIZEOF:: - - -File: gfortran.info, Node: SUM, Next: SYMLNK, Prev: STORAGE_SIZE, Up: Intrinsic Procedures - -8.236 'SUM' -- Sum of array elements -==================================== - -_Description_: - Adds the elements of ARRAY along dimension DIM if the corresponding - element in MASK is 'TRUE'. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = SUM(ARRAY[, MASK])' - 'RESULT = SUM(ARRAY, DIM[, MASK])' - -_Arguments_: - ARRAY Shall be an array of type 'INTEGER', 'REAL' or - 'COMPLEX'. - DIM (Optional) shall be a scalar of type 'INTEGER' - with a value in the range from 1 to n, where n - equals the rank of ARRAY. - MASK (Optional) shall be of type 'LOGICAL' and either - be a scalar or an array of the same shape as - ARRAY. - -_Return value_: - The result is of the same type as ARRAY. - - If DIM is absent, a scalar with the sum of all elements in ARRAY is - returned. Otherwise, an array of rank n-1, where n equals the rank - of ARRAY, and a shape similar to that of ARRAY with dimension DIM - dropped is returned. - -_Example_: - PROGRAM test_sum - INTEGER :: x(5) = (/ 1, 2, 3, 4 ,5 /) - print *, SUM(x) ! all elements, sum = 15 - print *, SUM(x, MASK=MOD(x, 2)==1) ! odd elements, sum = 9 - END PROGRAM - -_See also_: - *note PRODUCT:: - - -File: gfortran.info, Node: SYMLNK, Next: SYSTEM, Prev: SUM, Up: Intrinsic Procedures - -8.237 'SYMLNK' -- Create a symbolic link -======================================== - -_Description_: - Makes a symbolic link from file PATH1 to PATH2. A null character - ('CHAR(0)') can be used to mark the end of the names in PATH1 and - PATH2; otherwise, trailing blanks in the file names are ignored. - If the STATUS argument is supplied, it contains 0 on success or a - nonzero error code upon return; see 'symlink(2)'. If the system - does not supply 'symlink(2)', 'ENOSYS' is returned. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL SYMLNK(PATH1, PATH2 [, STATUS])' - 'STATUS = SYMLNK(PATH1, PATH2)' - -_Arguments_: - PATH1 Shall be of default 'CHARACTER' type. - PATH2 Shall be of default 'CHARACTER' type. - STATUS (Optional) Shall be of default 'INTEGER' type. - -_See also_: - *note LINK::, *note UNLINK:: - - -File: gfortran.info, Node: SYSTEM, Next: SYSTEM_CLOCK, Prev: SYMLNK, Up: Intrinsic Procedures - -8.238 'SYSTEM' -- Execute a shell command -========================================= - -_Description_: - Passes the command COMMAND to a shell (see 'system(3)'). If - argument STATUS is present, it contains the value returned by - 'system(3)', which is presumably 0 if the shell command succeeded. - Note that which shell is used to invoke the command is - system-dependent and environment-dependent. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - - Note that the 'system' function need not be thread-safe. It is the - responsibility of the user to ensure that 'system' is not called - concurrently. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL SYSTEM(COMMAND [, STATUS])' - 'STATUS = SYSTEM(COMMAND)' - -_Arguments_: - COMMAND Shall be of default 'CHARACTER' type. - STATUS (Optional) Shall be of default 'INTEGER' type. - -_See also_: - *note EXECUTE_COMMAND_LINE::, which is part of the Fortran 2008 - standard and should considered in new code for future portability. - - -File: gfortran.info, Node: SYSTEM_CLOCK, Next: TAN, Prev: SYSTEM, Up: Intrinsic Procedures - -8.239 'SYSTEM_CLOCK' -- Time function -===================================== - -_Description_: - Determines the COUNT of a processor clock since an unspecified time - in the past modulo COUNT_MAX, COUNT_RATE determines the number of - clock ticks per second. If the platform supports a monotonic - clock, that clock is used and can, depending on the platform clock - implementation, provide up to nanosecond resolution. If a - monotonic clock is not available, the implementation falls back to - a realtime clock. - - COUNT_RATE is system dependent and can vary depending on the kind - of the arguments. For KIND=4 arguments, COUNT represents - milliseconds, while for KIND=8 arguments, COUNT typically - represents micro- or nanoseconds depending on resolution of the - underlying platform clock. COUNT_MAX usually equals - 'HUGE(COUNT_MAX)'. Note that the millisecond resolution of the - KIND=4 version implies that the COUNT will wrap around in roughly - 25 days. In order to avoid issues with the wrap around and for - more precise timing, please use the KIND=8 version. - - If there is no clock, or querying the clock fails, COUNT is set to - '-HUGE(COUNT)', and COUNT_RATE and COUNT_MAX are set to zero. - - When running on a platform using the GNU C library (glibc) version - 2.16 or older, or a derivative thereof, the high resolution - monotonic clock is available only when linking with the RT library. - This can be done explicitly by adding the '-lrt' flag when linking - the application, but is also done implicitly when using OpenMP. - - On the Windows platform, the version with KIND=4 arguments uses the - 'GetTickCount' function, whereas the KIND=8 version uses - 'QueryPerformanceCounter' and 'QueryPerformanceCounterFrequency'. - For more information, and potential caveats, please see the - platform documentation. - -_Standard_: - Fortran 95 and later - -_Class_: - Subroutine - -_Syntax_: - 'CALL SYSTEM_CLOCK([COUNT, COUNT_RATE, COUNT_MAX])' - -_Arguments_: - COUNT (Optional) shall be a scalar of type 'INTEGER' - with 'INTENT(OUT)'. - COUNT_RATE (Optional) shall be a scalar of type 'INTEGER' - with 'INTENT(OUT)'. - COUNT_MAX (Optional) shall be a scalar of type 'INTEGER' - with 'INTENT(OUT)'. - -_Example_: - PROGRAM test_system_clock - INTEGER :: count, count_rate, count_max - CALL SYSTEM_CLOCK(count, count_rate, count_max) - WRITE(*,*) count, count_rate, count_max - END PROGRAM - -_See also_: - *note DATE_AND_TIME::, *note CPU_TIME:: - - -File: gfortran.info, Node: TAN, Next: TANH, Prev: SYSTEM_CLOCK, Up: Intrinsic Procedures - -8.240 'TAN' -- Tangent function -=============================== - -_Description_: - 'TAN(X)' computes the tangent of X. - -_Standard_: - Fortran 77 and later, for a complex argument Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = TAN(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. - -_Example_: - program test_tan - real(8) :: x = 0.165_8 - x = tan(x) - end program test_tan - -_Specific names_: - Name Argument Return type Standard - 'TAN(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and - later - 'DTAN(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and - later - -_See also_: - *note ATAN:: - - -File: gfortran.info, Node: TANH, Next: THIS_IMAGE, Prev: TAN, Up: Intrinsic Procedures - -8.241 'TANH' -- Hyperbolic tangent function -=========================================== - -_Description_: - 'TANH(X)' computes the hyperbolic tangent of X. - -_Standard_: - Fortran 77 and later, for a complex argument Fortran 2008 or later - -_Class_: - Elemental function - -_Syntax_: - 'X = TANH(X)' - -_Arguments_: - X The type shall be 'REAL' or 'COMPLEX'. - -_Return value_: - The return value has same type and kind as X. If X is complex, the - imaginary part of the result is in radians. If X is 'REAL', the - return value lies in the range - 1 \leq tanh(x) \leq 1 . - -_Example_: - program test_tanh - real(8) :: x = 2.1_8 - x = tanh(x) - end program test_tanh - -_Specific names_: - Name Argument Return type Standard - 'TANH(X)' 'REAL(4) X' 'REAL(4)' Fortran 95 and - later - 'DTANH(X)' 'REAL(8) X' 'REAL(8)' Fortran 95 and - later - -_See also_: - *note ATANH:: - - -File: gfortran.info, Node: THIS_IMAGE, Next: TIME, Prev: TANH, Up: Intrinsic Procedures - -8.242 'THIS_IMAGE' -- Function that returns the cosubscript index of this image -=============================================================================== - -_Description_: - Returns the cosubscript for this image. - -_Standard_: - Fortran 2008 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = THIS_IMAGE()' - 'RESULT = THIS_IMAGE(COARRAY [, DIM])' - -_Arguments_: - COARRAY Coarray of any type (optional; if DIM present, - required). - DIM default integer scalar (optional). If present, - DIM shall be between one and the corank of - COARRAY. - -_Return value_: - Default integer. If COARRAY is not present, it is scalar and its - value is the index of the invoking image. Otherwise, if DIM is not - present, a rank-1 array with corank elements is returned, - containing the cosubscripts for COARRAY specifying the invoking - image. If DIM is present, a scalar is returned, with the value of - the DIM element of 'THIS_IMAGE(COARRAY)'. - -_Example_: - INTEGER :: value[*] - INTEGER :: i - value = THIS_IMAGE() - SYNC ALL - IF (THIS_IMAGE() == 1) THEN - DO i = 1, NUM_IMAGES() - WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i] - END DO - END IF - -_See also_: - *note NUM_IMAGES::, *note IMAGE_INDEX:: - - -File: gfortran.info, Node: TIME, Next: TIME8, Prev: THIS_IMAGE, Up: Intrinsic Procedures - -8.243 'TIME' -- Time function -============================= - -_Description_: - Returns the current time encoded as an integer (in the manner of - the function 'time(3)' in the C standard library). This value is - suitable for passing to 'CTIME', 'GMTIME', and 'LTIME'. - - This intrinsic is not fully portable, such as to systems with - 32-bit 'INTEGER' types but supporting times wider than 32 bits. - Therefore, the values returned by this intrinsic might be, or - become, negative, or numerically less than previous values, during - a single run of the compiled program. - - See *note TIME8::, for information on a similar intrinsic that - might be portable to more GNU Fortran implementations, though to - fewer Fortran compilers. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = TIME()' - -_Return value_: - The return value is a scalar of type 'INTEGER(4)'. - -_See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::, *note - TIME8:: - - -File: gfortran.info, Node: TIME8, Next: TINY, Prev: TIME, Up: Intrinsic Procedures - -8.244 'TIME8' -- Time function (64-bit) -======================================= - -_Description_: - Returns the current time encoded as an integer (in the manner of - the function 'time(3)' in the C standard library). This value is - suitable for passing to 'CTIME', 'GMTIME', and 'LTIME'. - - _Warning:_ this intrinsic does not increase the range of the timing - values over that returned by 'time(3)'. On a system with a 32-bit - 'time(3)', 'TIME8' will return a 32-bit value, even though it is - converted to a 64-bit 'INTEGER(8)' value. That means overflows of - the 32-bit value can still occur. Therefore, the values returned - by this intrinsic might be or become negative or numerically less - than previous values during a single run of the compiled program. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = TIME8()' - -_Return value_: - The return value is a scalar of type 'INTEGER(8)'. - -_See also_: - *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK8::, - *note TIME:: - - -File: gfortran.info, Node: TINY, Next: TRAILZ, Prev: TIME8, Up: Intrinsic Procedures - -8.245 'TINY' -- Smallest positive number of a real kind -======================================================= - -_Description_: - 'TINY(X)' returns the smallest positive (non zero) number in the - model of the type of 'X'. - -_Standard_: - Fortran 95 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = TINY(X)' - -_Arguments_: - X Shall be of type 'REAL'. - -_Return value_: - The return value is of the same type and kind as X - -_Example_: - See 'HUGE' for an example. - - -File: gfortran.info, Node: TRAILZ, Next: TRANSFER, Prev: TINY, Up: Intrinsic Procedures - -8.246 'TRAILZ' -- Number of trailing zero bits of an integer -============================================================ - -_Description_: - 'TRAILZ' returns the number of trailing zero bits of an integer. - -_Standard_: - Fortran 2008 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = TRAILZ(I)' - -_Arguments_: - I Shall be of type 'INTEGER'. - -_Return value_: - The type of the return value is the default 'INTEGER'. If all the - bits of 'I' are zero, the result value is 'BIT_SIZE(I)'. - -_Example_: - PROGRAM test_trailz - WRITE (*,*) TRAILZ(8) ! prints 3 - END PROGRAM - -_See also_: - *note BIT_SIZE::, *note LEADZ::, *note POPPAR::, *note POPCNT:: - - -File: gfortran.info, Node: TRANSFER, Next: TRANSPOSE, Prev: TRAILZ, Up: Intrinsic Procedures - -8.247 'TRANSFER' -- Transfer bit patterns -========================================= - -_Description_: - Interprets the bitwise representation of SOURCE in memory as if it - is the representation of a variable or array of the same type and - type parameters as MOLD. - - This is approximately equivalent to the C concept of _casting_ one - type to another. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = TRANSFER(SOURCE, MOLD[, SIZE])' - -_Arguments_: - SOURCE Shall be a scalar or an array of any type. - MOLD Shall be a scalar or an array of any type. - SIZE (Optional) shall be a scalar of type 'INTEGER'. - -_Return value_: - The result has the same type as MOLD, with the bit level - representation of SOURCE. If SIZE is present, the result is a - one-dimensional array of length SIZE. If SIZE is absent but MOLD - is an array (of any size or shape), the result is a one- - dimensional array of the minimum length needed to contain the - entirety of the bitwise representation of SOURCE. If SIZE is - absent and MOLD is a scalar, the result is a scalar. - - If the bitwise representation of the result is longer than that of - SOURCE, then the leading bits of the result correspond to those of - SOURCE and any trailing bits are filled arbitrarily. - - When the resulting bit representation does not correspond to a - valid representation of a variable of the same type as MOLD, the - results are undefined, and subsequent operations on the result - cannot be guaranteed to produce sensible behavior. For example, it - is possible to create 'LOGICAL' variables for which 'VAR' and - '.NOT.VAR' both appear to be true. - -_Example_: - PROGRAM test_transfer - integer :: x = 2143289344 - print *, transfer(x, 1.0) ! prints "NaN" on i686 - END PROGRAM - - -File: gfortran.info, Node: TRANSPOSE, Next: TRIM, Prev: TRANSFER, Up: Intrinsic Procedures - -8.248 'TRANSPOSE' -- Transpose an array of rank two -=================================================== - -_Description_: - Transpose an array of rank two. Element (i, j) of the result has - the value 'MATRIX(j, i)', for all i, j. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = TRANSPOSE(MATRIX)' - -_Arguments_: - MATRIX Shall be an array of any type and have a rank of - two. - -_Return value_: - The result has the same type as MATRIX, and has shape '(/ m, n /)' - if MATRIX has shape '(/ n, m /)'. - - -File: gfortran.info, Node: TRIM, Next: TTYNAM, Prev: TRANSPOSE, Up: Intrinsic Procedures - -8.249 'TRIM' -- Remove trailing blank characters of a string -============================================================ - -_Description_: - Removes trailing blank characters of a string. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = TRIM(STRING)' - -_Arguments_: - STRING Shall be a scalar of type 'CHARACTER'. - -_Return value_: - A scalar of type 'CHARACTER' which length is that of STRING less - the number of trailing blanks. - -_Example_: - PROGRAM test_trim - CHARACTER(len=10), PARAMETER :: s = "GFORTRAN " - WRITE(*,*) LEN(s), LEN(TRIM(s)) ! "10 8", with/without trailing blanks - END PROGRAM - -_See also_: - *note ADJUSTL::, *note ADJUSTR:: - - -File: gfortran.info, Node: TTYNAM, Next: UBOUND, Prev: TRIM, Up: Intrinsic Procedures - -8.250 'TTYNAM' -- Get the name of a terminal device. -==================================================== - -_Description_: - Get the name of a terminal device. For more information, see - 'ttyname(3)'. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL TTYNAM(UNIT, NAME)' - 'NAME = TTYNAM(UNIT)' - -_Arguments_: - UNIT Shall be a scalar 'INTEGER'. - NAME Shall be of type 'CHARACTER'. - -_Example_: - PROGRAM test_ttynam - INTEGER :: unit - DO unit = 1, 10 - IF (isatty(unit=unit)) write(*,*) ttynam(unit) - END DO - END PROGRAM - -_See also_: - *note ISATTY:: - - -File: gfortran.info, Node: UBOUND, Next: UCOBOUND, Prev: TTYNAM, Up: Intrinsic Procedures - -8.251 'UBOUND' -- Upper dimension bounds of an array -==================================================== - -_Description_: - Returns the upper bounds of an array, or a single upper bound along - the DIM dimension. -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = UBOUND(ARRAY [, DIM [, KIND]])' - -_Arguments_: - ARRAY Shall be an array, of any type. - DIM (Optional) Shall be a scalar 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. If DIM is - absent, the result is an array of the upper bounds of ARRAY. If - DIM is present, the result is a scalar corresponding to the upper - bound of the array along that dimension. If ARRAY is an expression - rather than a whole array or array structure component, or if it - has a zero extent along the relevant dimension, the upper bound is - taken to be the number of elements along the relevant dimension. - -_See also_: - *note LBOUND::, *note LCOBOUND:: - - -File: gfortran.info, Node: UCOBOUND, Next: UMASK, Prev: UBOUND, Up: Intrinsic Procedures - -8.252 'UCOBOUND' -- Upper codimension bounds of an array -======================================================== - -_Description_: - Returns the upper cobounds of a coarray, or a single upper cobound - along the DIM codimension. -_Standard_: - Fortran 2008 and later - -_Class_: - Inquiry function - -_Syntax_: - 'RESULT = UCOBOUND(COARRAY [, DIM [, KIND]])' - -_Arguments_: - ARRAY Shall be an coarray, of any type. - DIM (Optional) Shall be a scalar 'INTEGER'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. If DIM is - absent, the result is an array of the lower cobounds of COARRAY. - If DIM is present, the result is a scalar corresponding to the - lower cobound of the array along that codimension. - -_See also_: - *note LCOBOUND::, *note LBOUND:: - - -File: gfortran.info, Node: UMASK, Next: UNLINK, Prev: UCOBOUND, Up: Intrinsic Procedures - -8.253 'UMASK' -- Set the file creation mask -=========================================== - -_Description_: - Sets the file creation mask to MASK. If called as a function, it - returns the old value. If called as a subroutine and argument OLD - if it is supplied, it is set to the old value. See 'umask(2)'. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL UMASK(MASK [, OLD])' - 'OLD = UMASK(MASK)' - -_Arguments_: - MASK Shall be a scalar of type 'INTEGER'. - OLD (Optional) Shall be a scalar of type 'INTEGER'. - - -File: gfortran.info, Node: UNLINK, Next: UNPACK, Prev: UMASK, Up: Intrinsic Procedures - -8.254 'UNLINK' -- Remove a file from the file system -==================================================== - -_Description_: - Unlinks the file PATH. A null character ('CHAR(0)') can be used to - mark the end of the name in PATH; otherwise, trailing blanks in the - file name are ignored. If the STATUS argument is supplied, it - contains 0 on success or a nonzero error code upon return; see - 'unlink(2)'. - - This intrinsic is provided in both subroutine and function forms; - however, only one form can be used in any given program unit. - -_Standard_: - GNU extension - -_Class_: - Subroutine, function - -_Syntax_: - 'CALL UNLINK(PATH [, STATUS])' - 'STATUS = UNLINK(PATH)' - -_Arguments_: - PATH Shall be of default 'CHARACTER' type. - STATUS (Optional) Shall be of default 'INTEGER' type. - -_See also_: - *note LINK::, *note SYMLNK:: - - -File: gfortran.info, Node: UNPACK, Next: VERIFY, Prev: UNLINK, Up: Intrinsic Procedures - -8.255 'UNPACK' -- Unpack an array of rank one into an array -=========================================================== - -_Description_: - Store the elements of VECTOR in an array of higher rank. - -_Standard_: - Fortran 95 and later - -_Class_: - Transformational function - -_Syntax_: - 'RESULT = UNPACK(VECTOR, MASK, FIELD)' - -_Arguments_: - VECTOR Shall be an array of any type and rank one. It - shall have at least as many elements as MASK has - 'TRUE' values. - MASK Shall be an array of type 'LOGICAL'. - FIELD Shall be of the same type as VECTOR and have the - same shape as MASK. - -_Return value_: - The resulting array corresponds to FIELD with 'TRUE' elements of - MASK replaced by values from VECTOR in array element order. - -_Example_: - PROGRAM test_unpack - integer :: vector(2) = (/1,1/) - logical :: mask(4) = (/ .TRUE., .FALSE., .FALSE., .TRUE. /) - integer :: field(2,2) = 0, unity(2,2) - - ! result: unity matrix - unity = unpack(vector, reshape(mask, (/2,2/)), field) - END PROGRAM - -_See also_: - *note PACK::, *note SPREAD:: - - -File: gfortran.info, Node: VERIFY, Next: XOR, Prev: UNPACK, Up: Intrinsic Procedures - -8.256 'VERIFY' -- Scan a string for characters not a given set -============================================================== - -_Description_: - Verifies that all the characters in STRING belong to the set of - characters in SET. - - If BACK is either absent or equals 'FALSE', this function returns - the position of the leftmost character of STRING that is not in - SET. If BACK equals 'TRUE', the rightmost position is returned. - If all characters of STRING are found in SET, the result is zero. - -_Standard_: - Fortran 95 and later, with KIND argument Fortran 2003 and later - -_Class_: - Elemental function - -_Syntax_: - 'RESULT = VERIFY(STRING, SET[, BACK [, KIND]])' - -_Arguments_: - STRING Shall be of type 'CHARACTER'. - SET Shall be of type 'CHARACTER'. - BACK (Optional) shall be of type 'LOGICAL'. - KIND (Optional) An 'INTEGER' initialization - expression indicating the kind parameter of the - result. - -_Return value_: - The return value is of type 'INTEGER' and of kind KIND. If KIND is - absent, the return value is of default integer kind. - -_Example_: - PROGRAM test_verify - WRITE(*,*) VERIFY("FORTRAN", "AO") ! 1, found 'F' - WRITE(*,*) VERIFY("FORTRAN", "FOO") ! 3, found 'R' - WRITE(*,*) VERIFY("FORTRAN", "C++") ! 1, found 'F' - WRITE(*,*) VERIFY("FORTRAN", "C++", .TRUE.) ! 7, found 'N' - WRITE(*,*) VERIFY("FORTRAN", "FORTRAN") ! 0' found none - END PROGRAM - -_See also_: - *note SCAN::, *note INDEX intrinsic:: - - -File: gfortran.info, Node: XOR, Prev: VERIFY, Up: Intrinsic Procedures - -8.257 'XOR' -- Bitwise logical exclusive OR -=========================================== - -_Description_: - Bitwise logical exclusive or. - - This intrinsic routine is provided for backwards compatibility with - GNU Fortran 77. For integer arguments, programmers should consider - the use of the *note IEOR:: intrinsic and for logical arguments the - '.NEQV.' operator, which are both defined by the Fortran standard. - -_Standard_: - GNU extension - -_Class_: - Function - -_Syntax_: - 'RESULT = XOR(I, J)' - -_Arguments_: - I The type shall be either a scalar 'INTEGER' type - or a scalar 'LOGICAL' type. - J The type shall be the same as the type of I. - -_Return value_: - The return type is either a scalar 'INTEGER' or a scalar 'LOGICAL'. - If the kind type parameters differ, then the smaller kind type is - implicitly converted to larger kind, and the return has the larger - kind. - -_Example_: - PROGRAM test_xor - LOGICAL :: T = .TRUE., F = .FALSE. - INTEGER :: a, b - DATA a / Z'F' /, b / Z'3' / - - WRITE (*,*) XOR(T, T), XOR(T, F), XOR(F, T), XOR(F, F) - WRITE (*,*) XOR(a, b) - END PROGRAM - -_See also_: - Fortran 95 elemental function: *note IEOR:: - - -File: gfortran.info, Node: Intrinsic Modules, Next: Contributing, Prev: Intrinsic Procedures, Up: Top - -9 Intrinsic Modules -******************* - -* Menu: - -* ISO_FORTRAN_ENV:: -* ISO_C_BINDING:: -* OpenMP Modules OMP_LIB and OMP_LIB_KINDS:: - - -File: gfortran.info, Node: ISO_FORTRAN_ENV, Next: ISO_C_BINDING, Up: Intrinsic Modules - -9.1 'ISO_FORTRAN_ENV' -===================== - -_Standard_: - Fortran 2003 and later, except when otherwise noted - - The 'ISO_FORTRAN_ENV' module provides the following scalar -default-integer named constants: - -'ATOMIC_INT_KIND': - Default-kind integer constant to be used as kind parameter when - defining integer variables used in atomic operations. (Fortran - 2008 or later.) - -'ATOMIC_LOGICAL_KIND': - Default-kind integer constant to be used as kind parameter when - defining logical variables used in atomic operations. (Fortran - 2008 or later.) - -'CHARACTER_KINDS': - Default-kind integer constant array of rank one containing the - supported kind parameters of the 'CHARACTER' type. (Fortran 2008 - or later.) - -'CHARACTER_STORAGE_SIZE': - Size in bits of the character storage unit. - -'ERROR_UNIT': - Identifies the preconnected unit used for error reporting. - -'FILE_STORAGE_SIZE': - Size in bits of the file-storage unit. - -'INPUT_UNIT': - Identifies the preconnected unit identified by the asterisk ('*') - in 'READ' statement. - -'INT8', 'INT16', 'INT32', 'INT64': - Kind type parameters to specify an INTEGER type with a storage size - of 16, 32, and 64 bits. It is negative if a target platform does - not support the particular kind. (Fortran 2008 or later.) - -'INTEGER_KINDS': - Default-kind integer constant array of rank one containing the - supported kind parameters of the 'INTEGER' type. (Fortran 2008 or - later.) - -'IOSTAT_END': - The value assigned to the variable passed to the 'IOSTAT=' - specifier of an input/output statement if an end-of-file condition - occurred. - -'IOSTAT_EOR': - The value assigned to the variable passed to the 'IOSTAT=' - specifier of an input/output statement if an end-of-record - condition occurred. - -'IOSTAT_INQUIRE_INTERNAL_UNIT': - Scalar default-integer constant, used by 'INQUIRE' for the - 'IOSTAT=' specifier to denote an that a unit number identifies an - internal unit. (Fortran 2008 or later.) - -'NUMERIC_STORAGE_SIZE': - The size in bits of the numeric storage unit. - -'LOGICAL_KINDS': - Default-kind integer constant array of rank one containing the - supported kind parameters of the 'LOGICAL' type. (Fortran 2008 or - later.) - -'OUTPUT_UNIT': - Identifies the preconnected unit identified by the asterisk ('*') - in 'WRITE' statement. - -'REAL32', 'REAL64', 'REAL128': - Kind type parameters to specify a REAL type with a storage size of - 32, 64, and 128 bits. It is negative if a target platform does not - support the particular kind. (Fortran 2008 or later.) - -'REAL_KINDS': - Default-kind integer constant array of rank one containing the - supported kind parameters of the 'REAL' type. (Fortran 2008 or - later.) - -'STAT_LOCKED': - Scalar default-integer constant used as STAT= return value by - 'LOCK' to denote that the lock variable is locked by the executing - image. (Fortran 2008 or later.) - -'STAT_LOCKED_OTHER_IMAGE': - Scalar default-integer constant used as STAT= return value by - 'UNLOCK' to denote that the lock variable is locked by another - image. (Fortran 2008 or later.) - -'STAT_STOPPED_IMAGE': - Positive, scalar default-integer constant used as STAT= return - value if the argument in the statement requires synchronisation - with an image, which has initiated the termination of the - execution. (Fortran 2008 or later.) - -'STAT_UNLOCKED': - Scalar default-integer constant used as STAT= return value by - 'UNLOCK' to denote that the lock variable is unlocked. (Fortran - 2008 or later.) - - The module provides the following derived type: - -'LOCK_TYPE': - Derived type with private components to be use with the 'LOCK' and - 'UNLOCK' statement. A variable of its type has to be always - declared as coarray and may not appear in a variable-definition - context. (Fortran 2008 or later.) - - The module also provides the following intrinsic procedures: *note -COMPILER_OPTIONS:: and *note COMPILER_VERSION::. - - -File: gfortran.info, Node: ISO_C_BINDING, Next: OpenMP Modules OMP_LIB and OMP_LIB_KINDS, Prev: ISO_FORTRAN_ENV, Up: Intrinsic Modules - -9.2 'ISO_C_BINDING' -=================== - -_Standard_: - Fortran 2003 and later, GNU extensions - - The following intrinsic procedures are provided by the module; their -definition can be found in the section Intrinsic Procedures of this -manual. - -'C_ASSOCIATED' -'C_F_POINTER' -'C_F_PROCPOINTER' -'C_FUNLOC' -'C_LOC' -'C_SIZEOF' - - The 'ISO_C_BINDING' module provides the following named constants of -type default integer, which can be used as KIND type parameters. - - In addition to the integer named constants required by the Fortran -2003 standard and 'C_PTRDIFF_T' of TS 29113, GNU Fortran provides as an -extension named constants for the 128-bit integer types supported by the -C compiler: 'C_INT128_T, C_INT_LEAST128_T, C_INT_FAST128_T'. -Furthermore, if '__float128' is supported in C, the named constants -'C_FLOAT128, C_FLOAT128_COMPLEX' are defined. - -Fortran Named constant C type Extension -Type -'INTEGER' 'C_INT' 'int' -'INTEGER' 'C_SHORT' 'short int' -'INTEGER' 'C_LONG' 'long int' -'INTEGER' 'C_LONG_LONG' 'long long int' -'INTEGER' 'C_SIGNED_CHAR' 'signed char'/'unsigned - char' -'INTEGER' 'C_SIZE_T' 'size_t' -'INTEGER' 'C_INT8_T' 'int8_t' -'INTEGER' 'C_INT16_T' 'int16_t' -'INTEGER' 'C_INT32_T' 'int32_t' -'INTEGER' 'C_INT64_T' 'int64_t' -'INTEGER' 'C_INT128_T' 'int128_t' Ext. -'INTEGER' 'C_INT_LEAST8_T' 'int_least8_t' -'INTEGER' 'C_INT_LEAST16_T' 'int_least16_t' -'INTEGER' 'C_INT_LEAST32_T' 'int_least32_t' -'INTEGER' 'C_INT_LEAST64_T' 'int_least64_t' -'INTEGER' 'C_INT_LEAST128_T' 'int_least128_t' Ext. -'INTEGER' 'C_INT_FAST8_T' 'int_fast8_t' -'INTEGER' 'C_INT_FAST16_T' 'int_fast16_t' -'INTEGER' 'C_INT_FAST32_T' 'int_fast32_t' -'INTEGER' 'C_INT_FAST64_T' 'int_fast64_t' -'INTEGER' 'C_INT_FAST128_T' 'int_fast128_t' Ext. -'INTEGER' 'C_INTMAX_T' 'intmax_t' -'INTEGER' 'C_INTPTR_T' 'intptr_t' -'INTEGER' 'C_PTRDIFF_T' 'intptr_t' TS 29113 -'REAL' 'C_FLOAT' 'float' -'REAL' 'C_DOUBLE' 'double' -'REAL' 'C_LONG_DOUBLE' 'long double' -'REAL' 'C_FLOAT128' '__float128' Ext. -'COMPLEX' 'C_FLOAT_COMPLEX' 'float _Complex' -'COMPLEX' 'C_DOUBLE_COMPLEX' 'double _Complex' -'COMPLEX' 'C_LONG_DOUBLE_COMPLEX' 'long double _Complex' -'REAL' 'C_FLOAT128_COMPLEX' '__float128 _Complex' Ext. -'LOGICAL' 'C_BOOL' '_Bool' -'CHARACTER' 'C_CHAR' 'char' - - Additionally, the following parameters of type -'CHARACTER(KIND=C_CHAR)' are defined. - -Name C definition Value -'C_NULL_CHAR' null character ''\0'' -'C_ALERT' alert ''\a'' -'C_BACKSPACE' backspace ''\b'' -'C_FORM_FEED' form feed ''\f'' -'C_NEW_LINE' new line ''\n'' -'C_CARRIAGE_RETURN'carriage return ''\r'' -'C_HORIZONTAL_TAB'horizontal tab ''\t'' -'C_VERTICAL_TAB'vertical tab ''\v'' - - Moreover, the following two named constants are defined: - -Name Type -'C_NULL_PTR' 'C_PTR' -'C_NULL_FUNPTR''C_FUNPTR' - - Both are equivalent to the value 'NULL' in C. - - -File: gfortran.info, Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS, Prev: ISO_C_BINDING, Up: Intrinsic Modules - -9.3 OpenMP Modules 'OMP_LIB' and 'OMP_LIB_KINDS' -================================================ - -_Standard_: - OpenMP Application Program Interface v4.0 - - The OpenMP Fortran runtime library routines are provided both in a -form of two Fortran 90 modules, named 'OMP_LIB' and 'OMP_LIB_KINDS', and -in a form of a Fortran 'include' file named 'omp_lib.h'. The procedures -provided by 'OMP_LIB' can be found in the *note Introduction: -(libgomp)Top. manual, the named constants defined in the modules are -listed below. - - For details refer to the actual OpenMP Application Program Interface -v4.0 (http://www.openmp.org/mp-documents/OpenMP4.0.0.pdf). - - 'OMP_LIB_KINDS' provides the following scalar default-integer named -constants: - -'omp_lock_kind' -'omp_nest_lock_kind' -'omp_proc_bind_kind' -'omp_sched_kind' - - 'OMP_LIB' provides the scalar default-integer named constant -'openmp_version' with a value of the form YYYYMM, where 'yyyy' is the -year and MM the month of the OpenMP version; for OpenMP v3.1 the value -is '201107' and for OpenMP v4.0 the value is '201307'. - - The following scalar integer named constants of the kind -'omp_sched_kind': - -'omp_sched_static' -'omp_sched_dynamic' -'omp_sched_guided' -'omp_sched_auto' - - And the following scalar integer named constants of the kind -'omp_proc_bind_kind': - -'omp_proc_bind_false' -'omp_proc_bind_true' -'omp_proc_bind_master' -'omp_proc_bind_close' -'omp_proc_bind_spread' - - -File: gfortran.info, Node: Contributing, Next: Copying, Prev: Intrinsic Modules, Up: Top - -Contributing -************ - -Free software is only possible if people contribute to efforts to create -it. We're always in need of more people helping out with ideas and -comments, writing documentation and contributing code. - - If you want to contribute to GNU Fortran, have a look at the long -lists of projects you can take on. Some of these projects are small, -some of them are large; some are completely orthogonal to the rest of -what is happening on GNU Fortran, but others are "mainstream" projects -in need of enthusiastic hackers. All of these projects are important! -We will eventually get around to the things here, but they are also -things doable by someone who is willing and able. - -* Menu: - -* Contributors:: -* Projects:: -* Proposed Extensions:: - - -File: gfortran.info, Node: Contributors, Next: Projects, Up: Contributing - -Contributors to GNU Fortran -=========================== - -Most of the parser was hand-crafted by _Andy Vaught_, who is also the -initiator of the whole project. Thanks Andy! Most of the interface -with GCC was written by _Paul Brook_. - - The following individuals have contributed code and/or ideas and -significant help to the GNU Fortran project (in alphabetical order): - - - Janne Blomqvist - - Steven Bosscher - - Paul Brook - - Tobias Burnus - - Franc,ois-Xavier Coudert - - Bud Davis - - Jerry DeLisle - - Erik Edelmann - - Bernhard Fischer - - Daniel Franke - - Richard Guenther - - Richard Henderson - - Katherine Holcomb - - Jakub Jelinek - - Niels Kristian Bech Jensen - - Steven Johnson - - Steven G. Kargl - - Thomas Koenig - - Asher Langton - - H. J. Lu - - Toon Moene - - Brooks Moses - - Andrew Pinski - - Tim Prince - - Christopher D. Rickett - - Richard Sandiford - - Tobias Schlu"ter - - Roger Sayle - - Paul Thomas - - Andy Vaught - - Feng Wang - - Janus Weil - - Daniel Kraft - - The following people have contributed bug reports, smaller or larger -patches, and much needed feedback and encouragement for the GNU Fortran -project: - - - Bill Clodius - - Dominique d'Humie`res - - Kate Hedstrom - - Erik Schnetter - - Joost VandeVondele - - Many other individuals have helped debug, test and improve the GNU -Fortran compiler over the past few years, and we welcome you to do the -same! If you already have done so, and you would like to see your name -listed in the list above, please contact us. - - -File: gfortran.info, Node: Projects, Next: Proposed Extensions, Prev: Contributors, Up: Contributing - -Projects -======== - -_Help build the test suite_ - Solicit more code for donation to the test suite: the more - extensive the testsuite, the smaller the risk of breaking things in - the future! We can keep code private on request. - -_Bug hunting/squishing_ - Find bugs and write more test cases! Test cases are especially - very welcome, because it allows us to concentrate on fixing bugs - instead of isolating them. Going through the bugzilla database at - <http://gcc.gnu.org/bugzilla/> to reduce testcases posted there and - add more information (for example, for which version does the - testcase work, for which versions does it fail?) is also very - helpful. - - -File: gfortran.info, Node: Proposed Extensions, Prev: Projects, Up: Contributing - -Proposed Extensions -=================== - -Here's a list of proposed extensions for the GNU Fortran compiler, in no -particular order. Most of these are necessary to be fully compatible -with existing Fortran compilers, but they are not part of the official -J3 Fortran 95 standard. - -Compiler extensions: --------------------- - - * User-specified alignment rules for structures. - - * Automatically extend single precision constants to double. - - * Compile code that conserves memory by dynamically allocating common - and module storage either on stack or heap. - - * Compile flag to generate code for array conformance checking - (suggest -CC). - - * User control of symbol names (underscores, etc). - - * Compile setting for maximum size of stack frame size before - spilling parts to static or heap. - - * Flag to force local variables into static space. - - * Flag to force local variables onto stack. - -Environment Options -------------------- - - * Pluggable library modules for random numbers, linear algebra. LA - should use BLAS calling conventions. - - * Environment variables controlling actions on arithmetic exceptions - like overflow, underflow, precision loss--Generate NaN, abort, - default. action. - - * Set precision for fp units that support it (i387). - - * Variable for setting fp rounding mode. - - * Variable to fill uninitialized variables with a user-defined bit - pattern. - - * Environment variable controlling filename that is opened for that - unit number. - - * Environment variable to clear/trash memory being freed. - - * Environment variable to control tracing of allocations and frees. - - * Environment variable to display allocated memory at normal program - end. - - * Environment variable for filename for * IO-unit. - - * Environment variable for temporary file directory. - - * Environment variable forcing standard output to be line buffered - (Unix). - - -File: gfortran.info, Node: Copying, Next: GNU Free Documentation License, Prev: Contributing, Up: Top - -GNU General Public License -************************** - - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> - - Everyone is permitted to copy and distribute verbatim copies of this - license document, but changing it is not allowed. - -Preamble -======== - -The GNU General Public License is a free, copyleft license for software -and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program-to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - -TERMS AND CONDITIONS -==================== - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public - License. - - "Copyright" also means copyright-like laws that apply to other - kinds of works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this - License. Each licensee is addressed as "you". "Licensees" and - "recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the - work in a fashion requiring copyright permission, other than the - making of an exact copy. The resulting work is called a "modified - version" of the earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work - based on the Program. - - To "propagate" a work means to do anything with it that, without - permission, would make you directly or secondarily liable for - infringement under applicable copyright law, except executing it on - a computer or modifying a private copy. Propagation includes - copying, distribution (with or without modification), making - available to the public, and in some countries other activities as - well. - - To "convey" a work means any kind of propagation that enables other - parties to make or receive copies. Mere interaction with a user - through a computer network, with no transfer of a copy, is not - conveying. - - An interactive user interface displays "Appropriate Legal Notices" - to the extent that it includes a convenient and prominently visible - feature that (1) displays an appropriate copyright notice, and (2) - tells the user that there is no warranty for the work (except to - the extent that warranties are provided), that licensees may convey - the work under this License, and how to view a copy of this - License. If the interface presents a list of user commands or - options, such as a menu, a prominent item in the list meets this - criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work - for making modifications to it. "Object code" means any non-source - form of a work. - - A "Standard Interface" means an interface that either is an - official standard defined by a recognized standards body, or, in - the case of interfaces specified for a particular programming - language, one that is widely used among developers working in that - language. - - The "System Libraries" of an executable work include anything, - other than the work as a whole, that (a) is included in the normal - form of packaging a Major Component, but which is not part of that - Major Component, and (b) serves only to enable use of the work with - that Major Component, or to implement a Standard Interface for - which an implementation is available to the public in source code - form. A "Major Component", in this context, means a major - essential component (kernel, window system, and so on) of the - specific operating system (if any) on which the executable work - runs, or a compiler used to produce the work, or an object code - interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all - the source code needed to generate, install, and (for an executable - work) run the object code and to modify the work, including scripts - to control those activities. However, it does not include the - work's System Libraries, or general-purpose tools or generally - available free programs which are used unmodified in performing - those activities but which are not part of the work. For example, - Corresponding Source includes interface definition files associated - with source files for the work, and the source code for shared - libraries and dynamically linked subprograms that the work is - specifically designed to require, such as by intimate data - communication or control flow between those subprograms and other - parts of the work. - - The Corresponding Source need not include anything that users can - regenerate automatically from other parts of the Corresponding - Source. - - The Corresponding Source for a work in source code form is that - same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of - copyright on the Program, and are irrevocable provided the stated - conditions are met. This License explicitly affirms your unlimited - permission to run the unmodified Program. The output from running - a covered work is covered by this License only if the output, given - its content, constitutes a covered work. This License acknowledges - your rights of fair use or other equivalent, as provided by - copyright law. - - You may make, run and propagate covered works that you do not - convey, without conditions so long as your license otherwise - remains in force. You may convey covered works to others for the - sole purpose of having them make modifications exclusively for you, - or provide you with facilities for running those works, provided - that you comply with the terms of this License in conveying all - material for which you do not control copyright. Those thus making - or running the covered works for you must do so exclusively on your - behalf, under your direction and control, on terms that prohibit - them from making any copies of your copyrighted material outside - their relationship with you. - - Conveying under any other circumstances is permitted solely under - the conditions stated below. Sublicensing is not allowed; section - 10 makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological - measure under any applicable law fulfilling obligations under - article 11 of the WIPO copyright treaty adopted on 20 December - 1996, or similar laws prohibiting or restricting circumvention of - such measures. - - When you convey a covered work, you waive any legal power to forbid - circumvention of technological measures to the extent such - circumvention is effected by exercising rights under this License - with respect to the covered work, and you disclaim any intention to - limit operation or modification of the work as a means of - enforcing, against the work's users, your or third parties' legal - rights to forbid circumvention of technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you - receive it, in any medium, provided that you conspicuously and - appropriately publish on each copy an appropriate copyright notice; - keep intact all notices stating that this License and any - non-permissive terms added in accord with section 7 apply to the - code; keep intact all notices of the absence of any warranty; and - give all recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, - and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to - produce it from the Program, in the form of source code under the - terms of section 4, provided that you also meet all of these - conditions: - - a. The work must carry prominent notices stating that you - modified it, and giving a relevant date. - - b. The work must carry prominent notices stating that it is - released under this License and any conditions added under - section 7. This requirement modifies the requirement in - section 4 to "keep intact all notices". - - c. You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable - section 7 additional terms, to the whole of the work, and all - its parts, regardless of how they are packaged. This License - gives no permission to license the work in any other way, but - it does not invalidate such permission if you have separately - received it. - - d. If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has - interactive interfaces that do not display Appropriate Legal - Notices, your work need not make them do so. - - A compilation of a covered work with other separate and independent - works, which are not by their nature extensions of the covered - work, and which are not combined with it such as to form a larger - program, in or on a volume of a storage or distribution medium, is - called an "aggregate" if the compilation and its resulting - copyright are not used to limit the access or legal rights of the - compilation's users beyond what the individual works permit. - Inclusion of a covered work in an aggregate does not cause this - License to apply to the other parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms - of sections 4 and 5, provided that you also convey the - machine-readable Corresponding Source under the terms of this - License, in one of these ways: - - a. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that - product model, to give anyone who possesses the object code - either (1) a copy of the Corresponding Source for all the - software in the product that is covered by this License, on a - durable physical medium customarily used for software - interchange, for a price no more than your reasonable cost of - physically performing this conveying of source, or (2) access - to copy the Corresponding Source from a network server at no - charge. - - c. Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, - and only if you received the object code with such an offer, - in accord with subsection 6b. - - d. Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to - the Corresponding Source in the same way through the same - place at no further charge. You need not require recipients - to copy the Corresponding Source along with the object code. - If the place to copy the object code is a network server, the - Corresponding Source may be on a different server (operated by - you or a third party) that supports equivalent copying - facilities, provided you maintain clear directions next to the - object code saying where to find the Corresponding Source. - Regardless of what server hosts the Corresponding Source, you - remain obligated to ensure that it is available for as long as - needed to satisfy these requirements. - - e. Convey the object code using peer-to-peer transmission, - provided you inform other peers where the object code and - Corresponding Source of the work are being offered to the - general public at no charge under subsection 6d. - - A separable portion of the object code, whose source code is - excluded from the Corresponding Source as a System Library, need - not be included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means - any tangible personal property which is normally used for personal, - family, or household purposes, or (2) anything designed or sold for - incorporation into a dwelling. In determining whether a product is - a consumer product, doubtful cases shall be resolved in favor of - coverage. For a particular product received by a particular user, - "normally used" refers to a typical or common use of that class of - product, regardless of the status of the particular user or of the - way in which the particular user actually uses, or expects or is - expected to use, the product. A product is a consumer product - regardless of whether the product has substantial commercial, - industrial or non-consumer uses, unless such uses represent the - only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, - procedures, authorization keys, or other information required to - install and execute modified versions of a covered work in that - User Product from a modified version of its Corresponding Source. - The information must suffice to ensure that the continued - functioning of the modified object code is in no case prevented or - interfered with solely because modification has been made. - - If you convey an object code work under this section in, or with, - or specifically for use in, a User Product, and the conveying - occurs as part of a transaction in which the right of possession - and use of the User Product is transferred to the recipient in - perpetuity or for a fixed term (regardless of how the transaction - is characterized), the Corresponding Source conveyed under this - section must be accompanied by the Installation Information. But - this requirement does not apply if neither you nor any third party - retains the ability to install modified object code on the User - Product (for example, the work has been installed in ROM). - - The requirement to provide Installation Information does not - include a requirement to continue to provide support service, - warranty, or updates for a work that has been modified or installed - by the recipient, or for the User Product in which it has been - modified or installed. Access to a network may be denied when the - modification itself materially and adversely affects the operation - of the network or violates the rules and protocols for - communication across the network. - - Corresponding Source conveyed, and Installation Information - provided, in accord with this section must be in a format that is - publicly documented (and with an implementation available to the - public in source code form), and must require no special password - or key for unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of - this License by making exceptions from one or more of its - conditions. Additional permissions that are applicable to the - entire Program shall be treated as though they were included in - this License, to the extent that they are valid under applicable - law. If additional permissions apply only to part of the Program, - that part may be used separately under those permissions, but the - entire Program remains governed by this License without regard to - the additional permissions. - - When you convey a copy of a covered work, you may at your option - remove any additional permissions from that copy, or from any part - of it. (Additional permissions may be written to require their own - removal in certain cases when you modify the work.) You may place - additional permissions on material, added by you to a covered work, - for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material - you add to a covered work, you may (if authorized by the copyright - holders of that material) supplement the terms of this License with - terms: - - a. Disclaiming warranty or limiting liability differently from - the terms of sections 15 and 16 of this License; or - - b. Requiring preservation of specified reasonable legal notices - or author attributions in that material or in the Appropriate - Legal Notices displayed by works containing it; or - - c. Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be marked - in reasonable ways as different from the original version; or - - d. Limiting the use for publicity purposes of names of licensors - or authors of the material; or - - e. Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f. Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified - versions of it) with contractual assumptions of liability to - the recipient, for any liability that these contractual - assumptions directly impose on those licensors and authors. - - All other non-permissive additional terms are considered "further - restrictions" within the meaning of section 10. If the Program as - you received it, or any part of it, contains a notice stating that - it is governed by this License along with a term that is a further - restriction, you may remove that term. If a license document - contains a further restriction but permits relicensing or conveying - under this License, you may add to a covered work material governed - by the terms of that license document, provided that the further - restriction does not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you - must place, in the relevant source files, a statement of the - additional terms that apply to those files, or a notice indicating - where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in - the form of a separately written license, or stated as exceptions; - the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly - provided under this License. Any attempt otherwise to propagate or - modify it is void, and will automatically terminate your rights - under this License (including any patent licenses granted under the - third paragraph of section 11). - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, you do not qualify to receive new licenses - for the same material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or - run a copy of the Program. Ancillary propagation of a covered work - occurring solely as a consequence of using peer-to-peer - transmission to receive a copy likewise does not require - acceptance. However, nothing other than this License grants you - permission to propagate or modify any covered work. These actions - infringe copyright if you do not accept this License. Therefore, - by modifying or propagating a covered work, you indicate your - acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically - receives a license from the original licensors, to run, modify and - propagate that work, subject to this License. You are not - responsible for enforcing compliance by third parties with this - License. - - An "entity transaction" is a transaction transferring control of an - organization, or substantially all assets of one, or subdividing an - organization, or merging organizations. If propagation of a - covered work results from an entity transaction, each party to that - transaction who receives a copy of the work also receives whatever - licenses to the work the party's predecessor in interest had or - could give under the previous paragraph, plus a right to possession - of the Corresponding Source of the work from the predecessor in - interest, if the predecessor has it or can get it with reasonable - efforts. - - You may not impose any further restrictions on the exercise of the - rights granted or affirmed under this License. For example, you - may not impose a license fee, royalty, or other charge for exercise - of rights granted under this License, and you may not initiate - litigation (including a cross-claim or counterclaim in a lawsuit) - alleging that any patent claim is infringed by making, using, - selling, offering for sale, or importing the Program or any portion - of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this - License of the Program or a work on which the Program is based. - The work thus licensed is called the contributor's "contributor - version". - - A contributor's "essential patent claims" are all patent claims - owned or controlled by the contributor, whether already acquired or - hereafter acquired, that would be infringed by some manner, - permitted by this License, of making, using, or selling its - contributor version, but do not include claims that would be - infringed only as a consequence of further modification of the - contributor version. For purposes of this definition, "control" - includes the right to grant patent sublicenses in a manner - consistent with the requirements of this License. - - Each contributor grants you a non-exclusive, worldwide, - royalty-free patent license under the contributor's essential - patent claims, to make, use, sell, offer for sale, import and - otherwise run, modify and propagate the contents of its contributor - version. - - In the following three paragraphs, a "patent license" is any - express agreement or commitment, however denominated, not to - enforce a patent (such as an express permission to practice a - patent or covenant not to sue for patent infringement). To "grant" - such a patent license to a party means to make such an agreement or - commitment not to enforce a patent against the party. - - If you convey a covered work, knowingly relying on a patent - license, and the Corresponding Source of the work is not available - for anyone to copy, free of charge and under the terms of this - License, through a publicly available network server or other - readily accessible means, then you must either (1) cause the - Corresponding Source to be so available, or (2) arrange to deprive - yourself of the benefit of the patent license for this particular - work, or (3) arrange, in a manner consistent with the requirements - of this License, to extend the patent license to downstream - recipients. "Knowingly relying" means you have actual knowledge - that, but for the patent license, your conveying the covered work - in a country, or your recipient's use of the covered work in a - country, would infringe one or more identifiable patents in that - country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or - arrangement, you convey, or propagate by procuring conveyance of, a - covered work, and grant a patent license to some of the parties - receiving the covered work authorizing them to use, propagate, - modify or convey a specific copy of the covered work, then the - patent license you grant is automatically extended to all - recipients of the covered work and works based on it. - - A patent license is "discriminatory" if it does not include within - the scope of its coverage, prohibits the exercise of, or is - conditioned on the non-exercise of one or more of the rights that - are specifically granted under this License. You may not convey a - covered work if you are a party to an arrangement with a third - party that is in the business of distributing software, under which - you make payment to the third party based on the extent of your - activity of conveying the work, and under which the third party - grants, to any of the parties who would receive the covered work - from you, a discriminatory patent license (a) in connection with - copies of the covered work conveyed by you (or copies made from - those copies), or (b) primarily for and in connection with specific - products or compilations that contain the covered work, unless you - entered into that arrangement, or that patent license was granted, - prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting - any implied license or other defenses to infringement that may - otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement - or otherwise) that contradict the conditions of this License, they - do not excuse you from the conditions of this License. If you - cannot convey a covered work so as to satisfy simultaneously your - obligations under this License and any other pertinent obligations, - then as a consequence you may not convey it at all. For example, - if you agree to terms that obligate you to collect a royalty for - further conveying from those to whom you convey the Program, the - only way you could satisfy both those terms and this License would - be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have - permission to link or combine any covered work with a work licensed - under version 3 of the GNU Affero General Public License into a - single combined work, and to convey the resulting work. The terms - of this License will continue to apply to the part which is the - covered work, but the special requirements of the GNU Affero - General Public License, section 13, concerning interaction through - a network will apply to the combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new - versions of the GNU General Public License from time to time. Such - new versions will be similar in spirit to the present version, but - may differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the - Program specifies that a certain numbered version of the GNU - General Public License "or any later version" applies to it, you - have the option of following the terms and conditions either of - that numbered version or of any later version published by the Free - Software Foundation. If the Program does not specify a version - number of the GNU General Public License, you may choose any - version ever published by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future - versions of the GNU General Public License can be used, that - proxy's public statement of acceptance of a version permanently - authorizes you to choose that version for the Program. - - Later license versions may give you additional or different - permissions. However, no additional obligations are imposed on any - author or copyright holder as a result of your choosing to follow a - later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY - APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE - COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" - WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, - INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE - RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. - SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL - NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN - WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES - AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR - DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR - CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE - THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA - BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD - PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER - PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF - THE POSSIBILITY OF SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided - above cannot be given local legal effect according to their terms, - reviewing courts shall apply local law that most closely - approximates an absolute waiver of all civil liability in - connection with the Program, unless a warranty or assumption of - liability accompanies a copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS -=========================== - -How to Apply These Terms to Your New Programs -============================================= - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these -terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. - Copyright (C) YEAR NAME OF AUTHOR - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or (at - your option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. - - Also add information on how to contact you by electronic and paper -mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - PROGRAM Copyright (C) YEAR NAME OF AUTHOR - This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type 'show c' for details. - - The hypothetical commands 'show w' and 'show c' should show the -appropriate parts of the General Public License. Of course, your -program's commands might be different; for a GUI interface, you would -use an "about box". - - You should also get your employer (if you work as a programmer) or -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. For more information on this, and how to apply and follow -the GNU GPL, see <http://www.gnu.org/licenses/>. - - The GNU General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Lesser General Public License instead of this License. But first, -please read <http://www.gnu.org/philosophy/why-not-lgpl.html>. - - -File: gfortran.info, Node: GNU Free Documentation License, Next: Funding, Prev: Copying, Up: Top - -GNU Free Documentation License -****************************** - - Version 1.3, 3 November 2008 - - Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. - <http://fsf.org/> - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - 0. PREAMBLE - - The purpose of this License is to make a manual, textbook, or other - functional and useful document "free" in the sense of freedom: to - assure everyone the effective freedom to copy and redistribute it, - with or without modifying it, either commercially or - noncommercially. Secondarily, this License preserves for the - author and publisher a way to get credit for their work, while not - being considered responsible for modifications made by others. - - This License is a kind of "copyleft", which means that derivative - works of the document must themselves be free in the same sense. - It complements the GNU General Public License, which is a copyleft - license designed for free software. - - We have designed this License in order to use it for manuals for - free software, because free software needs free documentation: a - free program should come with manuals providing the same freedoms - that the software does. But this License is not limited to - software manuals; it can be used for any textual work, regardless - of subject matter or whether it is published as a printed book. We - recommend this License principally for works whose purpose is - instruction or reference. - - 1. APPLICABILITY AND DEFINITIONS - - This License applies to any manual or other work, in any medium, - that contains a notice placed by the copyright holder saying it can - be distributed under the terms of this License. Such a notice - grants a world-wide, royalty-free license, unlimited in duration, - to use that work under the conditions stated herein. The - "Document", below, refers to any such manual or work. Any member - of the public is a licensee, and is addressed as "you". You accept - the license if you copy, modify or distribute the work in a way - requiring permission under copyright law. - - A "Modified Version" of the Document means any work containing the - Document or a portion of it, either copied verbatim, or with - modifications and/or translated into another language. - - A "Secondary Section" is a named appendix or a front-matter section - of the Document that deals exclusively with the relationship of the - publishers or authors of the Document to the Document's overall - subject (or to related matters) and contains nothing that could - fall directly within that overall subject. (Thus, if the Document - is in part a textbook of mathematics, a Secondary Section may not - explain any mathematics.) The relationship could be a matter of - historical connection with the subject or with related matters, or - of legal, commercial, philosophical, ethical or political position - regarding them. - - The "Invariant Sections" are certain Secondary Sections whose - titles are designated, as being those of Invariant Sections, in the - notice that says that the Document is released under this License. - If a section does not fit the above definition of Secondary then it - is not allowed to be designated as Invariant. The Document may - contain zero Invariant Sections. If the Document does not identify - any Invariant Sections then there are none. - - The "Cover Texts" are certain short passages of text that are - listed, as Front-Cover Texts or Back-Cover Texts, in the notice - that says that the Document is released under this License. A - Front-Cover Text may be at most 5 words, and a Back-Cover Text may - be at most 25 words. - - A "Transparent" copy of the Document means a machine-readable copy, - represented in a format whose specification is available to the - general public, that is suitable for revising the document - straightforwardly with generic text editors or (for images composed - of pixels) generic paint programs or (for drawings) some widely - available drawing editor, and that is suitable for input to text - formatters or for automatic translation to a variety of formats - suitable for input to text formatters. A copy made in an otherwise - Transparent file format whose markup, or absence of markup, has - been arranged to thwart or discourage subsequent modification by - readers is not Transparent. An image format is not Transparent if - used for any substantial amount of text. A copy that is not - "Transparent" is called "Opaque". - - Examples of suitable formats for Transparent copies include plain - ASCII without markup, Texinfo input format, LaTeX input format, - SGML or XML using a publicly available DTD, and standard-conforming - simple HTML, PostScript or PDF designed for human modification. - Examples of transparent image formats include PNG, XCF and JPG. - Opaque formats include proprietary formats that can be read and - edited only by proprietary word processors, SGML or XML for which - the DTD and/or processing tools are not generally available, and - the machine-generated HTML, PostScript or PDF produced by some word - processors for output purposes only. - - The "Title Page" means, for a printed book, the title page itself, - plus such following pages as are needed to hold, legibly, the - material this License requires to appear in the title page. For - works in formats which do not have any title page as such, "Title - Page" means the text near the most prominent appearance of the - work's title, preceding the beginning of the body of the text. - - The "publisher" means any person or entity that distributes copies - of the Document to the public. - - A section "Entitled XYZ" means a named subunit of the Document - whose title either is precisely XYZ or contains XYZ in parentheses - following text that translates XYZ in another language. (Here XYZ - stands for a specific section name mentioned below, such as - "Acknowledgements", "Dedications", "Endorsements", or "History".) - To "Preserve the Title" of such a section when you modify the - Document means that it remains a section "Entitled XYZ" according - to this definition. - - The Document may include Warranty Disclaimers next to the notice - which states that this License applies to the Document. These - Warranty Disclaimers are considered to be included by reference in - this License, but only as regards disclaiming warranties: any other - implication that these Warranty Disclaimers may have is void and - has no effect on the meaning of this License. - - 2. VERBATIM COPYING - - You may copy and distribute the Document in any medium, either - commercially or noncommercially, provided that this License, the - copyright notices, and the license notice saying this License - applies to the Document are reproduced in all copies, and that you - add no other conditions whatsoever to those of this License. You - may not use technical measures to obstruct or control the reading - or further copying of the copies you make or distribute. However, - you may accept compensation in exchange for copies. If you - distribute a large enough number of copies you must also follow the - conditions in section 3. - - You may also lend copies, under the same conditions stated above, - and you may publicly display copies. - - 3. COPYING IN QUANTITY - - If you publish printed copies (or copies in media that commonly - have printed covers) of the Document, numbering more than 100, and - the Document's license notice requires Cover Texts, you must - enclose the copies in covers that carry, clearly and legibly, all - these Cover Texts: Front-Cover Texts on the front cover, and - Back-Cover Texts on the back cover. Both covers must also clearly - and legibly identify you as the publisher of these copies. The - front cover must present the full title with all words of the title - equally prominent and visible. You may add other material on the - covers in addition. Copying with changes limited to the covers, as - long as they preserve the title of the Document and satisfy these - conditions, can be treated as verbatim copying in other respects. - - If the required texts for either cover are too voluminous to fit - legibly, you should put the first ones listed (as many as fit - reasonably) on the actual cover, and continue the rest onto - adjacent pages. - - If you publish or distribute Opaque copies of the Document - numbering more than 100, you must either include a machine-readable - Transparent copy along with each Opaque copy, or state in or with - each Opaque copy a computer-network location from which the general - network-using public has access to download using public-standard - network protocols a complete Transparent copy of the Document, free - of added material. If you use the latter option, you must take - reasonably prudent steps, when you begin distribution of Opaque - copies in quantity, to ensure that this Transparent copy will - remain thus accessible at the stated location until at least one - year after the last time you distribute an Opaque copy (directly or - through your agents or retailers) of that edition to the public. - - It is requested, but not required, that you contact the authors of - the Document well before redistributing any large number of copies, - to give them a chance to provide you with an updated version of the - Document. - - 4. MODIFICATIONS - - You may copy and distribute a Modified Version of the Document - under the conditions of sections 2 and 3 above, provided that you - release the Modified Version under precisely this License, with the - Modified Version filling the role of the Document, thus licensing - distribution and modification of the Modified Version to whoever - possesses a copy of it. In addition, you must do these things in - the Modified Version: - - A. Use in the Title Page (and on the covers, if any) a title - distinct from that of the Document, and from those of previous - versions (which should, if there were any, be listed in the - History section of the Document). You may use the same title - as a previous version if the original publisher of that - version gives permission. - - B. List on the Title Page, as authors, one or more persons or - entities responsible for authorship of the modifications in - the Modified Version, together with at least five of the - principal authors of the Document (all of its principal - authors, if it has fewer than five), unless they release you - from this requirement. - - C. State on the Title page the name of the publisher of the - Modified Version, as the publisher. - - D. Preserve all the copyright notices of the Document. - - E. Add an appropriate copyright notice for your modifications - adjacent to the other copyright notices. - - F. Include, immediately after the copyright notices, a license - notice giving the public permission to use the Modified - Version under the terms of this License, in the form shown in - the Addendum below. - - G. Preserve in that license notice the full lists of Invariant - Sections and required Cover Texts given in the Document's - license notice. - - H. Include an unaltered copy of this License. - - I. Preserve the section Entitled "History", Preserve its Title, - and add to it an item stating at least the title, year, new - authors, and publisher of the Modified Version as given on the - Title Page. If there is no section Entitled "History" in the - Document, create one stating the title, year, authors, and - publisher of the Document as given on its Title Page, then add - an item describing the Modified Version as stated in the - previous sentence. - - J. Preserve the network location, if any, given in the Document - for public access to a Transparent copy of the Document, and - likewise the network locations given in the Document for - previous versions it was based on. These may be placed in the - "History" section. You may omit a network location for a work - that was published at least four years before the Document - itself, or if the original publisher of the version it refers - to gives permission. - - K. For any section Entitled "Acknowledgements" or "Dedications", - Preserve the Title of the section, and preserve in the section - all the substance and tone of each of the contributor - acknowledgements and/or dedications given therein. - - L. Preserve all the Invariant Sections of the Document, unaltered - in their text and in their titles. Section numbers or the - equivalent are not considered part of the section titles. - - M. Delete any section Entitled "Endorsements". Such a section - may not be included in the Modified Version. - - N. Do not retitle any existing section to be Entitled - "Endorsements" or to conflict in title with any Invariant - Section. - - O. Preserve any Warranty Disclaimers. - - If the Modified Version includes new front-matter sections or - appendices that qualify as Secondary Sections and contain no - material copied from the Document, you may at your option designate - some or all of these sections as invariant. To do this, add their - titles to the list of Invariant Sections in the Modified Version's - license notice. These titles must be distinct from any other - section titles. - - You may add a section Entitled "Endorsements", provided it contains - nothing but endorsements of your Modified Version by various - parties--for example, statements of peer review or that the text - has been approved by an organization as the authoritative - definition of a standard. - - You may add a passage of up to five words as a Front-Cover Text, - and a passage of up to 25 words as a Back-Cover Text, to the end of - the list of Cover Texts in the Modified Version. Only one passage - of Front-Cover Text and one of Back-Cover Text may be added by (or - through arrangements made by) any one entity. If the Document - already includes a cover text for the same cover, previously added - by you or by arrangement made by the same entity you are acting on - behalf of, you may not add another; but you may replace the old - one, on explicit permission from the previous publisher that added - the old one. - - The author(s) and publisher(s) of the Document do not by this - License give permission to use their names for publicity for or to - assert or imply endorsement of any Modified Version. - - 5. COMBINING DOCUMENTS - - You may combine the Document with other documents released under - this License, under the terms defined in section 4 above for - modified versions, provided that you include in the combination all - of the Invariant Sections of all of the original documents, - unmodified, and list them all as Invariant Sections of your - combined work in its license notice, and that you preserve all - their Warranty Disclaimers. - - The combined work need only contain one copy of this License, and - multiple identical Invariant Sections may be replaced with a single - copy. If there are multiple Invariant Sections with the same name - but different contents, make the title of each such section unique - by adding at the end of it, in parentheses, the name of the - original author or publisher of that section if known, or else a - unique number. Make the same adjustment to the section titles in - the list of Invariant Sections in the license notice of the - combined work. - - In the combination, you must combine any sections Entitled - "History" in the various original documents, forming one section - Entitled "History"; likewise combine any sections Entitled - "Acknowledgements", and any sections Entitled "Dedications". You - must delete all sections Entitled "Endorsements." - - 6. COLLECTIONS OF DOCUMENTS - - You may make a collection consisting of the Document and other - documents released under this License, and replace the individual - copies of this License in the various documents with a single copy - that is included in the collection, provided that you follow the - rules of this License for verbatim copying of each of the documents - in all other respects. - - You may extract a single document from such a collection, and - distribute it individually under this License, provided you insert - a copy of this License into the extracted document, and follow this - License in all other respects regarding verbatim copying of that - document. - - 7. AGGREGATION WITH INDEPENDENT WORKS - - A compilation of the Document or its derivatives with other - separate and independent documents or works, in or on a volume of a - storage or distribution medium, is called an "aggregate" if the - copyright resulting from the compilation is not used to limit the - legal rights of the compilation's users beyond what the individual - works permit. When the Document is included in an aggregate, this - License does not apply to the other works in the aggregate which - are not themselves derivative works of the Document. - - If the Cover Text requirement of section 3 is applicable to these - copies of the Document, then if the Document is less than one half - of the entire aggregate, the Document's Cover Texts may be placed - on covers that bracket the Document within the aggregate, or the - electronic equivalent of covers if the Document is in electronic - form. Otherwise they must appear on printed covers that bracket - the whole aggregate. - - 8. TRANSLATION - - Translation is considered a kind of modification, so you may - distribute translations of the Document under the terms of section - 4. Replacing Invariant Sections with translations requires special - permission from their copyright holders, but you may include - translations of some or all Invariant Sections in addition to the - original versions of these Invariant Sections. You may include a - translation of this License, and all the license notices in the - Document, and any Warranty Disclaimers, provided that you also - include the original English version of this License and the - original versions of those notices and disclaimers. In case of a - disagreement between the translation and the original version of - this License or a notice or disclaimer, the original version will - prevail. - - If a section in the Document is Entitled "Acknowledgements", - "Dedications", or "History", the requirement (section 4) to - Preserve its Title (section 1) will typically require changing the - actual title. - - 9. TERMINATION - - You may not copy, modify, sublicense, or distribute the Document - except as expressly provided under this License. Any attempt - otherwise to copy, modify, sublicense, or distribute it is void, - and will automatically terminate your rights under this License. - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, receipt of a copy of some or all of the - same material does not give you any rights to use it. - - 10. FUTURE REVISIONS OF THIS LICENSE - - The Free Software Foundation may publish new, revised versions of - the GNU Free Documentation License from time to time. Such new - versions will be similar in spirit to the present version, but may - differ in detail to address new problems or concerns. See - <http://www.gnu.org/copyleft/>. - - Each version of the License is given a distinguishing version - number. If the Document specifies that a particular numbered - version of this License "or any later version" applies to it, you - have the option of following the terms and conditions either of - that specified version or of any later version that has been - published (not as a draft) by the Free Software Foundation. If the - Document does not specify a version number of this License, you may - choose any version ever published (not as a draft) by the Free - Software Foundation. If the Document specifies that a proxy can - decide which future versions of this License can be used, that - proxy's public statement of acceptance of a version permanently - authorizes you to choose that version for the Document. - - 11. RELICENSING - - "Massive Multiauthor Collaboration Site" (or "MMC Site") means any - World Wide Web server that publishes copyrightable works and also - provides prominent facilities for anybody to edit those works. A - public wiki that anybody can edit is an example of such a server. - A "Massive Multiauthor Collaboration" (or "MMC") contained in the - site means any set of copyrightable works thus published on the MMC - site. - - "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 - license published by Creative Commons Corporation, a not-for-profit - corporation with a principal place of business in San Francisco, - California, as well as future copyleft versions of that license - published by that same organization. - - "Incorporate" means to publish or republish a Document, in whole or - in part, as part of another Document. - - An MMC is "eligible for relicensing" if it is licensed under this - License, and if all works that were first published under this - License somewhere other than this MMC, and subsequently - incorporated in whole or in part into the MMC, (1) had no cover - texts or invariant sections, and (2) were thus incorporated prior - to November 1, 2008. - - The operator of an MMC Site may republish an MMC contained in the - site under CC-BY-SA on the same site at any time before August 1, - 2009, provided the MMC is eligible for relicensing. - -ADDENDUM: How to use this License for your documents -==================================================== - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and license -notices just after the title page: - - Copyright (C) YEAR YOUR NAME. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. - - If you have Invariant Sections, Front-Cover Texts and Back-Cover -Texts, replace the "with...Texts." line with this: - - with the Invariant Sections being LIST THEIR TITLES, with - the Front-Cover Texts being LIST, and with the Back-Cover Texts - being LIST. - - If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - - If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of free -software license, such as the GNU General Public License, to permit -their use in free software. - - -File: gfortran.info, Node: Funding, Next: Option Index, Prev: GNU Free Documentation License, Up: Top - -Funding Free Software -********************* - -If you want to have more free software a few years from now, it makes -sense for you to help encourage people to contribute funds for its -development. The most effective approach known is to encourage -commercial redistributors to donate. - - Users of free software systems can boost the pace of development by -encouraging for-a-fee distributors to donate part of their selling price -to free software developers--the Free Software Foundation, and others. - - The way to convince distributors to do this is to demand it and -expect it from them. So when you compare distributors, judge them -partly by how much they give to free software development. Show -distributors they must compete to be the one who gives the most. - - To make this approach work, you must insist on numbers that you can -compare, such as, "We will donate ten dollars to the Frobnitz project -for each disk sold." Don't be satisfied with a vague promise, such as -"A portion of the profits are donated," since it doesn't give a basis -for comparison. - - Even a precise fraction "of the profits from this disk" is not very -meaningful, since creative accounting and unrelated business decisions -can greatly alter what fraction of the sales price counts as profit. If -the price you pay is $50, ten percent of the profit is probably less -than a dollar; it might be a few cents, or nothing at all. - - Some redistributors do development work themselves. This is useful -too; but to keep everyone honest, you need to inquire how much they do, -and what kind. Some kinds of development make much more long-term -difference than others. For example, maintaining a separate version of -a program contributes very little; maintaining the standard version of a -program for the whole community contributes much. Easy new ports -contribute little, since someone else would surely do them; difficult -ports such as adding a new CPU to the GNU Compiler Collection contribute -more; major new features or packages contribute the most. - - By establishing the idea that supporting further development is "the -proper thing to do" when distributing free software for a fee, we can -assure a steady flow of resources into making more free software. - - Copyright (C) 1994 Free Software Foundation, Inc. - Verbatim copying and redistribution of this section is permitted - without royalty; alteration is not permitted. - - -File: gfortran.info, Node: Option Index, Next: Keyword Index, Prev: Funding, Up: Top - -Option Index -************ - -'gfortran''s command line options are indexed here without any initial -'-' or '--'. Where an option has both positive and negative forms (such -as -foption and -fno-option), relevant entries in the manual are indexed -under the most appropriate form; it may sometimes be useful to look up -both forms. - - -* Menu: - -* 'A-PREDICATE=ANSWER': Preprocessing Options. - (line 119) -* 'APREDICATE=ANSWER': Preprocessing Options. - (line 113) -* 'backslash': Fortran Dialect Options. - (line 40) -* 'C': Preprocessing Options. - (line 122) -* 'CC': Preprocessing Options. - (line 137) -* 'cpp': Preprocessing Options. - (line 12) -* 'dD': Preprocessing Options. - (line 35) -* 'dI': Preprocessing Options. - (line 51) -* 'dM': Preprocessing Options. - (line 26) -* 'dN': Preprocessing Options. - (line 41) -* 'DNAME': Preprocessing Options. - (line 151) -* 'DNAME=DEFINITION': Preprocessing Options. - (line 154) -* 'dU': Preprocessing Options. - (line 44) -* 'faggressive-function-elimination': Code Gen Options. (line 340) -* 'falign-commons': Code Gen Options. (line 313) -* 'fall-intrinsics': Fortran Dialect Options. - (line 17) -* 'fblas-matmul-limit': Code Gen Options. (line 268) -* 'fbounds-check': Code Gen Options. (line 192) -* 'fcheck': Code Gen Options. (line 142) -* 'fcheck-array-temporaries': Code Gen Options. (line 195) -* 'fcoarray': Code Gen Options. (line 128) -* 'fconvert='CONVERSION: Runtime Options. (line 10) -* 'fcray-pointer': Fortran Dialect Options. - (line 86) -* 'fd-lines-as-code': Fortran Dialect Options. - (line 27) -* 'fd-lines-as-comments': Fortran Dialect Options. - (line 27) -* 'fdefault-double-8': Fortran Dialect Options. - (line 124) -* 'fdefault-integer-8': Fortran Dialect Options. - (line 110) -* 'fdefault-real-8': Fortran Dialect Options. - (line 116) -* 'fdollar-ok': Fortran Dialect Options. - (line 34) -* 'fdump-fortran-optimized': Debugging Options. (line 15) -* 'fdump-fortran-original': Debugging Options. (line 10) -* 'fdump-parse-tree': Debugging Options. (line 19) -* 'fexternal-blas': Code Gen Options. (line 260) -* ff2c: Code Gen Options. (line 25) -* 'ffixed-line-length-'N: Fortran Dialect Options. - (line 57) -* 'ffpe-summary='LIST: Debugging Options. (line 51) -* 'ffpe-trap='LIST: Debugging Options. (line 25) -* 'ffree-form': Fortran Dialect Options. - (line 11) -* 'ffree-line-length-'N: Fortran Dialect Options. - (line 70) -* 'fimplicit-none': Fortran Dialect Options. - (line 81) -* 'finit-character': Code Gen Options. (line 288) -* 'finit-integer': Code Gen Options. (line 288) -* 'finit-local-zero': Code Gen Options. (line 288) -* 'finit-logical': Code Gen Options. (line 288) -* 'finit-real': Code Gen Options. (line 288) -* 'finteger-4-integer-8': Fortran Dialect Options. - (line 133) -* 'fintrinsic-modules-path' DIR: Directory Options. (line 36) -* 'fmax-array-constructor': Code Gen Options. (line 198) -* 'fmax-errors='N: Error and Warning Options. - (line 27) -* 'fmax-identifier-length='N: Fortran Dialect Options. - (line 77) -* 'fmax-stack-var-size': Code Gen Options. (line 216) -* 'fmax-subrecord-length='LENGTH: Runtime Options. (line 29) -* 'fmodule-private': Fortran Dialect Options. - (line 52) -* 'fno-automatic': Code Gen Options. (line 15) -* 'fno-backtrace': Debugging Options. (line 61) -* 'fno-fixed-form': Fortran Dialect Options. - (line 11) -* 'fno-protect-parens': Code Gen Options. (line 325) -* 'fno-underscoring': Code Gen Options. (line 54) -* 'fopenmp': Fortran Dialect Options. - (line 90) -* 'fpack-derived': Code Gen Options. (line 238) -* 'fpp': Preprocessing Options. - (line 12) -* 'frange-check': Fortran Dialect Options. - (line 98) -* 'freal-4-real-10': Fortran Dialect Options. - (line 148) -* 'freal-4-real-16': Fortran Dialect Options. - (line 148) -* 'freal-4-real-8': Fortran Dialect Options. - (line 148) -* 'freal-8-real-10': Fortran Dialect Options. - (line 148) -* 'freal-8-real-16': Fortran Dialect Options. - (line 148) -* 'freal-8-real-4': Fortran Dialect Options. - (line 148) -* 'frealloc-lhs': Code Gen Options. (line 334) -* 'frecord-marker='LENGTH: Runtime Options. (line 21) -* 'frecursive': Code Gen Options. (line 279) -* 'frepack-arrays': Code Gen Options. (line 244) -* 'frontend-optimize': Code Gen Options. (line 348) -* 'fsecond-underscore': Code Gen Options. (line 111) -* 'fshort-enums': Code Gen Options. (line 254) -* 'fshort-enums' <1>: Fortran 2003 status. (line 93) -* 'fsign-zero': Runtime Options. (line 34) -* 'fstack-arrays': Code Gen Options. (line 230) -* 'fsyntax-only': Error and Warning Options. - (line 33) -* 'fworking-directory': Preprocessing Options. - (line 55) -* 'H': Preprocessing Options. - (line 174) -* 'I'DIR: Directory Options. (line 14) -* 'idirafter DIR': Preprocessing Options. - (line 69) -* 'imultilib DIR': Preprocessing Options. - (line 76) -* 'iprefix PREFIX': Preprocessing Options. - (line 80) -* 'iquote DIR': Preprocessing Options. - (line 89) -* 'isysroot DIR': Preprocessing Options. - (line 85) -* 'isystem DIR': Preprocessing Options. - (line 96) -* 'J'DIR: Directory Options. (line 29) -* 'M'DIR: Directory Options. (line 29) -* 'nostdinc': Preprocessing Options. - (line 104) -* 'P': Preprocessing Options. - (line 179) -* 'pedantic': Error and Warning Options. - (line 38) -* 'pedantic-errors': Error and Warning Options. - (line 57) -* 'static-libgfortran': Link Options. (line 11) -* 'std='STD option: Fortran Dialect Options. - (line 159) -* 'UNAME': Preprocessing Options. - (line 185) -* 'undef': Preprocessing Options. - (line 109) -* 'Waliasing': Error and Warning Options. - (line 69) -* 'Walign-commons': Error and Warning Options. - (line 198) -* 'Wall': Error and Warning Options. - (line 61) -* 'Wampersand': Error and Warning Options. - (line 86) -* 'Warray-temporaries': Error and Warning Options. - (line 94) -* 'Wc-binding-type': Error and Warning Options. - (line 99) -* 'Wcharacter-truncation': Error and Warning Options. - (line 106) -* 'Wcompare-reals': Error and Warning Options. - (line 225) -* 'Wconversion': Error and Warning Options. - (line 113) -* 'Wconversion-extra': Error and Warning Options. - (line 117) -* 'Werror': Error and Warning Options. - (line 237) -* 'Wextra': Error and Warning Options. - (line 120) -* 'Wfunction-elimination': Error and Warning Options. - (line 204) -* 'Wimplicit-interface': Error and Warning Options. - (line 125) -* 'Wimplicit-procedure': Error and Warning Options. - (line 131) -* 'Wintrinsic-shadow': Error and Warning Options. - (line 180) -* 'Wintrinsics-std': Error and Warning Options. - (line 135) -* 'Wline-truncation': Error and Warning Options. - (line 109) -* 'Wreal-q-constant': Error and Warning Options. - (line 142) -* 'Wrealloc-lhs': Error and Warning Options. - (line 208) -* 'Wrealloc-lhs-all': Error and Warning Options. - (line 220) -* 'Wsurprising': Error and Warning Options. - (line 146) -* 'Wtabs': Error and Warning Options. - (line 168) -* 'Wtargt-lifetime': Error and Warning Options. - (line 229) -* 'Wunderflow': Error and Warning Options. - (line 176) -* 'Wunused-dummy-argument': Error and Warning Options. - (line 187) -* 'Wunused-parameter': Error and Warning Options. - (line 191) -* 'Wzerotrip': Error and Warning Options. - (line 233) - - -File: gfortran.info, Node: Keyword Index, Prev: Option Index, Up: Top - -Keyword Index -************* - - -* Menu: - -* '$': Fortran Dialect Options. - (line 34) -* '%LOC': Argument list functions. - (line 6) -* '%REF': Argument list functions. - (line 6) -* '%VAL': Argument list functions. - (line 6) -* '&': Error and Warning Options. - (line 86) -* '[...]': Fortran 2003 status. (line 78) -* _gfortran_set_args: _gfortran_set_args. (line 6) -* _gfortran_set_convert: _gfortran_set_convert. - (line 6) -* _gfortran_set_fpe: _gfortran_set_fpe. (line 6) -* _gfortran_set_max_subrecord_length: _gfortran_set_max_subrecord_length. - (line 6) -* _gfortran_set_options: _gfortran_set_options. - (line 6) -* _gfortran_set_record_marker: _gfortran_set_record_marker. - (line 6) -* ABORT: ABORT. (line 6) -* ABS: ABS. (line 6) -* absolute value: ABS. (line 6) -* ACCESS: ACCESS. (line 6) -* 'ACCESS='STREAM'' I/O: Fortran 2003 status. (line 103) -* ACHAR: ACHAR. (line 6) -* ACOS: ACOS. (line 6) -* ACOSH: ACOSH. (line 6) -* adjust string: ADJUSTL. (line 6) -* adjust string <1>: ADJUSTR. (line 6) -* ADJUSTL: ADJUSTL. (line 6) -* ADJUSTR: ADJUSTR. (line 6) -* AIMAG: AIMAG. (line 6) -* AINT: AINT. (line 6) -* ALARM: ALARM. (line 6) -* ALGAMA: LOG_GAMMA. (line 6) -* aliasing: Error and Warning Options. - (line 69) -* alignment of 'COMMON' blocks: Error and Warning Options. - (line 198) -* alignment of 'COMMON' blocks <1>: Code Gen Options. (line 313) -* ALL: ALL. (line 6) -* all warnings: Error and Warning Options. - (line 61) -* 'ALLOCATABLE' components of derived types: Fortran 2003 status. - (line 101) -* 'ALLOCATABLE' dummy arguments: Fortran 2003 status. (line 99) -* 'ALLOCATABLE' function results: Fortran 2003 status. (line 100) -* ALLOCATED: ALLOCATED. (line 6) -* allocation, moving: MOVE_ALLOC. (line 6) -* allocation, status: ALLOCATED. (line 6) -* ALOG: LOG. (line 6) -* ALOG10: LOG10. (line 6) -* AMAX0: MAX. (line 6) -* AMAX1: MAX. (line 6) -* AMIN0: MIN. (line 6) -* AMIN1: MIN. (line 6) -* AMOD: MOD. (line 6) -* AND: AND. (line 6) -* ANINT: ANINT. (line 6) -* ANY: ANY. (line 6) -* area hyperbolic cosine: ACOSH. (line 6) -* area hyperbolic sine: ASINH. (line 6) -* area hyperbolic tangent: ATANH. (line 6) -* argument list functions: Argument list functions. - (line 6) -* arguments, to program: COMMAND_ARGUMENT_COUNT. - (line 6) -* arguments, to program <1>: GETARG. (line 6) -* arguments, to program <2>: GET_COMMAND. (line 6) -* arguments, to program <3>: GET_COMMAND_ARGUMENT. - (line 6) -* arguments, to program <4>: IARGC. (line 6) -* array, add elements: SUM. (line 6) -* array, AND: IALL. (line 6) -* array, apply condition: ALL. (line 6) -* array, apply condition <1>: ANY. (line 6) -* array, bounds checking: Code Gen Options. (line 142) -* array, change dimensions: RESHAPE. (line 6) -* array, combine arrays: MERGE. (line 6) -* array, condition testing: ALL. (line 6) -* array, condition testing <1>: ANY. (line 6) -* array, conditionally add elements: SUM. (line 6) -* array, conditionally count elements: COUNT. (line 6) -* array, conditionally multiply elements: PRODUCT. (line 6) -* array, constructors: Fortran 2003 status. (line 78) -* array, count elements: SIZE. (line 6) -* array, duplicate dimensions: SPREAD. (line 6) -* array, duplicate elements: SPREAD. (line 6) -* array, element counting: COUNT. (line 6) -* array, gather elements: PACK. (line 6) -* array, increase dimension: SPREAD. (line 6) -* array, increase dimension <1>: UNPACK. (line 6) -* array, indices of type real: Real array indices. (line 6) -* array, location of maximum element: MAXLOC. (line 6) -* array, location of minimum element: MINLOC. (line 6) -* array, lower bound: LBOUND. (line 6) -* array, maximum value: MAXVAL. (line 6) -* array, merge arrays: MERGE. (line 6) -* array, minimum value: MINVAL. (line 6) -* array, multiply elements: PRODUCT. (line 6) -* array, number of elements: COUNT. (line 6) -* array, number of elements <1>: SIZE. (line 6) -* array, OR: IANY. (line 6) -* array, packing: PACK. (line 6) -* array, parity: IPARITY. (line 6) -* array, permutation: CSHIFT. (line 6) -* array, product: PRODUCT. (line 6) -* array, reduce dimension: PACK. (line 6) -* array, rotate: CSHIFT. (line 6) -* array, scatter elements: UNPACK. (line 6) -* array, shape: SHAPE. (line 6) -* array, shift: EOSHIFT. (line 6) -* array, shift circularly: CSHIFT. (line 6) -* array, size: SIZE. (line 6) -* array, sum: SUM. (line 6) -* array, transmogrify: RESHAPE. (line 6) -* array, transpose: TRANSPOSE. (line 6) -* array, unpacking: UNPACK. (line 6) -* array, upper bound: UBOUND. (line 6) -* array, XOR: IPARITY. (line 6) -* ASCII collating sequence: ACHAR. (line 6) -* ASCII collating sequence <1>: IACHAR. (line 6) -* ASIN: ASIN. (line 6) -* ASINH: ASINH. (line 6) -* ASSOCIATED: ASSOCIATED. (line 6) -* association status: ASSOCIATED. (line 6) -* association status, C pointer: C_ASSOCIATED. (line 6) -* ATAN: ATAN. (line 6) -* ATAN2: ATAN2. (line 6) -* ATANH: ATANH. (line 6) -* Atomic subroutine, define: ATOMIC_DEFINE. (line 6) -* Atomic subroutine, reference: ATOMIC_REF. (line 6) -* ATOMIC_DEFINE: ATOMIC_DEFINE. (line 6) -* ATOMIC_REF: ATOMIC_REF. (line 6) -* Authors: Contributors. (line 6) -* backslash: Fortran Dialect Options. - (line 40) -* BACKTRACE: BACKTRACE. (line 6) -* backtrace: Debugging Options. (line 61) -* backtrace <1>: BACKTRACE. (line 6) -* base 10 logarithm function: LOG10. (line 6) -* BESJ0: BESSEL_J0. (line 6) -* BESJ1: BESSEL_J1. (line 6) -* BESJN: BESSEL_JN. (line 6) -* Bessel function, first kind: BESSEL_J0. (line 6) -* Bessel function, first kind <1>: BESSEL_J1. (line 6) -* Bessel function, first kind <2>: BESSEL_JN. (line 6) -* Bessel function, second kind: BESSEL_Y0. (line 6) -* Bessel function, second kind <1>: BESSEL_Y1. (line 6) -* Bessel function, second kind <2>: BESSEL_YN. (line 6) -* BESSEL_J0: BESSEL_J0. (line 6) -* BESSEL_J1: BESSEL_J1. (line 6) -* BESSEL_JN: BESSEL_JN. (line 6) -* BESSEL_Y0: BESSEL_Y0. (line 6) -* BESSEL_Y1: BESSEL_Y1. (line 6) -* BESSEL_YN: BESSEL_YN. (line 6) -* BESY0: BESSEL_Y0. (line 6) -* BESY1: BESSEL_Y1. (line 6) -* BESYN: BESSEL_YN. (line 6) -* BGE: BGE. (line 6) -* BGT: BGT. (line 6) -* binary representation: POPCNT. (line 6) -* binary representation <1>: POPPAR. (line 6) -* bits set: POPCNT. (line 6) -* bits, AND of array elements: IALL. (line 6) -* bits, clear: IBCLR. (line 6) -* bits, extract: IBITS. (line 6) -* bits, get: IBITS. (line 6) -* bits, merge: MERGE_BITS. (line 6) -* bits, move: MVBITS. (line 6) -* bits, move <1>: TRANSFER. (line 6) -* bits, negate: NOT. (line 6) -* bits, number of: BIT_SIZE. (line 6) -* bits, OR of array elements: IANY. (line 6) -* bits, set: IBSET. (line 6) -* bits, shift: ISHFT. (line 6) -* bits, shift circular: ISHFTC. (line 6) -* bits, shift left: LSHIFT. (line 6) -* bits, shift left <1>: SHIFTL. (line 6) -* bits, shift right: RSHIFT. (line 6) -* bits, shift right <1>: SHIFTA. (line 6) -* bits, shift right <2>: SHIFTR. (line 6) -* bits, testing: BTEST. (line 6) -* bits, unset: IBCLR. (line 6) -* bits, XOR of array elements: IPARITY. (line 6) -* bitwise comparison: BGE. (line 6) -* bitwise comparison <1>: BGT. (line 6) -* bitwise comparison <2>: BLE. (line 6) -* bitwise comparison <3>: BLT. (line 6) -* bitwise logical and: AND. (line 6) -* bitwise logical and <1>: IAND. (line 6) -* bitwise logical exclusive or: IEOR. (line 6) -* bitwise logical exclusive or <1>: XOR. (line 6) -* bitwise logical not: NOT. (line 6) -* bitwise logical or: IOR. (line 6) -* bitwise logical or <1>: OR. (line 6) -* BIT_SIZE: BIT_SIZE. (line 6) -* BLE: BLE. (line 6) -* BLT: BLT. (line 6) -* bounds checking: Code Gen Options. (line 142) -* BOZ literal constants: BOZ literal constants. - (line 6) -* BTEST: BTEST. (line 6) -* CABS: ABS. (line 6) -* calling convention: Code Gen Options. (line 25) -* CCOS: COS. (line 6) -* CDABS: ABS. (line 6) -* CDCOS: COS. (line 6) -* CDEXP: EXP. (line 6) -* CDLOG: LOG. (line 6) -* CDSIN: SIN. (line 6) -* CDSQRT: SQRT. (line 6) -* CEILING: CEILING. (line 6) -* ceiling: ANINT. (line 6) -* ceiling <1>: CEILING. (line 6) -* CEXP: EXP. (line 6) -* CHAR: CHAR. (line 6) -* character kind: SELECTED_CHAR_KIND. (line 6) -* character set: Fortran Dialect Options. - (line 34) -* CHDIR: CHDIR. (line 6) -* checking array temporaries: Code Gen Options. (line 142) -* checking subscripts: Code Gen Options. (line 142) -* CHMOD: CHMOD. (line 6) -* clock ticks: MCLOCK. (line 6) -* clock ticks <1>: MCLOCK8. (line 6) -* clock ticks <2>: SYSTEM_CLOCK. (line 6) -* CLOG: LOG. (line 6) -* CMPLX: CMPLX. (line 6) -* coarray, 'IMAGE_INDEX': IMAGE_INDEX. (line 6) -* coarray, lower bound: LCOBOUND. (line 6) -* coarray, 'NUM_IMAGES': NUM_IMAGES. (line 6) -* coarray, 'THIS_IMAGE': THIS_IMAGE. (line 6) -* coarray, upper bound: UCOBOUND. (line 6) -* coarrays: Code Gen Options. (line 128) -* code generation, conventions: Code Gen Options. (line 6) -* collating sequence, ASCII: ACHAR. (line 6) -* collating sequence, ASCII <1>: IACHAR. (line 6) -* command line: EXECUTE_COMMAND_LINE. - (line 6) -* command options: Invoking GNU Fortran. - (line 6) -* command-line arguments: COMMAND_ARGUMENT_COUNT. - (line 6) -* command-line arguments <1>: GETARG. (line 6) -* command-line arguments <2>: GET_COMMAND. (line 6) -* command-line arguments <3>: GET_COMMAND_ARGUMENT. - (line 6) -* command-line arguments <4>: IARGC. (line 6) -* command-line arguments, number of: COMMAND_ARGUMENT_COUNT. - (line 6) -* command-line arguments, number of <1>: IARGC. (line 6) -* COMMAND_ARGUMENT_COUNT: COMMAND_ARGUMENT_COUNT. - (line 6) -* 'COMMON': Volatile COMMON blocks. - (line 6) -* compiler flags inquiry function: COMPILER_OPTIONS. (line 6) -* compiler, name and version: COMPILER_VERSION. (line 6) -* COMPILER_OPTIONS: COMPILER_OPTIONS. (line 6) -* COMPILER_VERSION: COMPILER_VERSION. (line 6) -* COMPLEX: COMPLEX. (line 6) -* complex conjugate: CONJG. (line 6) -* Complex function: Alternate complex function syntax. - (line 6) -* complex numbers, conversion to: CMPLX. (line 6) -* complex numbers, conversion to <1>: COMPLEX. (line 6) -* complex numbers, conversion to <2>: DCMPLX. (line 6) -* complex numbers, imaginary part: AIMAG. (line 6) -* complex numbers, real part: DREAL. (line 6) -* complex numbers, real part <1>: REAL. (line 6) -* Conditional compilation: Preprocessing and conditional compilation. - (line 6) -* CONJG: CONJG. (line 6) -* consistency, durability: Data consistency and durability. - (line 6) -* Contributing: Contributing. (line 6) -* Contributors: Contributors. (line 6) -* conversion: Error and Warning Options. - (line 113) -* conversion <1>: Error and Warning Options. - (line 117) -* conversion, to character: CHAR. (line 6) -* conversion, to complex: CMPLX. (line 6) -* conversion, to complex <1>: COMPLEX. (line 6) -* conversion, to complex <2>: DCMPLX. (line 6) -* conversion, to integer: Implicitly convert LOGICAL and INTEGER values. - (line 6) -* conversion, to integer <1>: IACHAR. (line 6) -* conversion, to integer <2>: ICHAR. (line 6) -* conversion, to integer <3>: INT. (line 6) -* conversion, to integer <4>: INT2. (line 6) -* conversion, to integer <5>: INT8. (line 6) -* conversion, to integer <6>: LONG. (line 6) -* conversion, to logical: Implicitly convert LOGICAL and INTEGER values. - (line 6) -* conversion, to logical <1>: LOGICAL. (line 6) -* conversion, to real: DBLE. (line 6) -* conversion, to real <1>: REAL. (line 6) -* conversion, to string: CTIME. (line 6) -* 'CONVERT' specifier: CONVERT specifier. (line 6) -* core, dump: ABORT. (line 6) -* COS: COS. (line 6) -* COSH: COSH. (line 6) -* cosine: COS. (line 6) -* cosine, hyperbolic: COSH. (line 6) -* cosine, hyperbolic, inverse: ACOSH. (line 6) -* cosine, inverse: ACOS. (line 6) -* COUNT: COUNT. (line 6) -* CPP: Preprocessing and conditional compilation. - (line 6) -* CPP <1>: Preprocessing Options. - (line 6) -* CPU_TIME: CPU_TIME. (line 6) -* Credits: Contributors. (line 6) -* CSHIFT: CSHIFT. (line 6) -* CSIN: SIN. (line 6) -* CSQRT: SQRT. (line 6) -* CTIME: CTIME. (line 6) -* current date: DATE_AND_TIME. (line 6) -* current date <1>: FDATE. (line 6) -* current date <2>: IDATE. (line 6) -* current time: DATE_AND_TIME. (line 6) -* current time <1>: FDATE. (line 6) -* current time <2>: ITIME. (line 6) -* current time <3>: TIME. (line 6) -* current time <4>: TIME8. (line 6) -* C_ASSOCIATED: C_ASSOCIATED. (line 6) -* C_FUNLOC: C_FUNLOC. (line 6) -* C_F_POINTER: C_F_POINTER. (line 6) -* C_F_PROCPOINTER: C_F_PROCPOINTER. (line 6) -* C_LOC: C_LOC. (line 6) -* C_SIZEOF: C_SIZEOF. (line 6) -* DABS: ABS. (line 6) -* DACOS: ACOS. (line 6) -* DACOSH: ACOSH. (line 6) -* DASIN: ASIN. (line 6) -* DASINH: ASINH. (line 6) -* DATAN: ATAN. (line 6) -* DATAN2: ATAN2. (line 6) -* DATANH: ATANH. (line 6) -* date, current: DATE_AND_TIME. (line 6) -* date, current <1>: FDATE. (line 6) -* date, current <2>: IDATE. (line 6) -* DATE_AND_TIME: DATE_AND_TIME. (line 6) -* DBESJ0: BESSEL_J0. (line 6) -* DBESJ1: BESSEL_J1. (line 6) -* DBESJN: BESSEL_JN. (line 6) -* DBESY0: BESSEL_Y0. (line 6) -* DBESY1: BESSEL_Y1. (line 6) -* DBESYN: BESSEL_YN. (line 6) -* DBLE: DBLE. (line 6) -* DCMPLX: DCMPLX. (line 6) -* DCONJG: CONJG. (line 6) -* DCOS: COS. (line 6) -* DCOSH: COSH. (line 6) -* DDIM: DIM. (line 6) -* debugging information options: Debugging Options. (line 6) -* debugging, preprocessor: Preprocessing Options. - (line 26) -* debugging, preprocessor <1>: Preprocessing Options. - (line 35) -* debugging, preprocessor <2>: Preprocessing Options. - (line 41) -* debugging, preprocessor <3>: Preprocessing Options. - (line 44) -* debugging, preprocessor <4>: Preprocessing Options. - (line 51) -* 'DECODE': ENCODE and DECODE statements. - (line 6) -* delayed execution: ALARM. (line 6) -* delayed execution <1>: SLEEP. (line 6) -* DEXP: EXP. (line 6) -* DFLOAT: REAL. (line 6) -* DGAMMA: GAMMA. (line 6) -* dialect options: Fortran Dialect Options. - (line 6) -* DIGITS: DIGITS. (line 6) -* DIM: DIM. (line 6) -* DIMAG: AIMAG. (line 6) -* DINT: AINT. (line 6) -* directive, 'INCLUDE': Directory Options. (line 6) -* directory, options: Directory Options. (line 6) -* directory, search paths for inclusion: Directory Options. (line 14) -* division, modulo: MODULO. (line 6) -* division, remainder: MOD. (line 6) -* DLGAMA: LOG_GAMMA. (line 6) -* DLOG: LOG. (line 6) -* DLOG10: LOG10. (line 6) -* DMAX1: MAX. (line 6) -* DMIN1: MIN. (line 6) -* DMOD: MOD. (line 6) -* DNINT: ANINT. (line 6) -* dot product: DOT_PRODUCT. (line 6) -* DOT_PRODUCT: DOT_PRODUCT. (line 6) -* DPROD: DPROD. (line 6) -* DREAL: DREAL. (line 6) -* DSHIFTL: DSHIFTL. (line 6) -* DSHIFTR: DSHIFTR. (line 6) -* DSIGN: SIGN. (line 6) -* DSIN: SIN. (line 6) -* DSINH: SINH. (line 6) -* DSQRT: SQRT. (line 6) -* DTAN: TAN. (line 6) -* DTANH: TANH. (line 6) -* DTIME: DTIME. (line 6) -* dummy argument, unused: Error and Warning Options. - (line 187) -* elapsed time: DTIME. (line 6) -* elapsed time <1>: SECNDS. (line 6) -* elapsed time <2>: SECOND. (line 6) -* Elimination of functions with identical argument lists: Code Gen Options. - (line 340) -* 'ENCODE': ENCODE and DECODE statements. - (line 6) -* 'ENUM' statement: Fortran 2003 status. (line 93) -* 'ENUMERATOR' statement: Fortran 2003 status. (line 93) -* environment variable: Environment Variables. - (line 6) -* environment variable <1>: Runtime. (line 6) -* environment variable <2>: GETENV. (line 6) -* environment variable <3>: GET_ENVIRONMENT_VARIABLE. - (line 6) -* EOSHIFT: EOSHIFT. (line 6) -* EPSILON: EPSILON. (line 6) -* ERF: ERF. (line 6) -* ERFC: ERFC. (line 6) -* ERFC_SCALED: ERFC_SCALED. (line 6) -* error function: ERF. (line 6) -* error function, complementary: ERFC. (line 6) -* error function, complementary, exponentially-scaled: ERFC_SCALED. - (line 6) -* errors, limiting: Error and Warning Options. - (line 27) -* escape characters: Fortran Dialect Options. - (line 40) -* ETIME: ETIME. (line 6) -* Euclidean distance: HYPOT. (line 6) -* Euclidean vector norm: NORM2. (line 6) -* EXECUTE_COMMAND_LINE: EXECUTE_COMMAND_LINE. - (line 6) -* EXIT: EXIT. (line 6) -* EXP: EXP. (line 6) -* EXPONENT: EXPONENT. (line 6) -* exponential function: EXP. (line 6) -* exponential function, inverse: LOG. (line 6) -* exponential function, inverse <1>: LOG10. (line 6) -* expression size: C_SIZEOF. (line 6) -* expression size <1>: SIZEOF. (line 6) -* EXTENDS_TYPE_OF: EXTENDS_TYPE_OF. (line 6) -* extensions: Extensions. (line 6) -* extensions, implemented: Extensions implemented in GNU Fortran. - (line 6) -* extensions, not implemented: Extensions not implemented in GNU Fortran. - (line 6) -* extra warnings: Error and Warning Options. - (line 120) -* 'f2c' calling convention: Code Gen Options. (line 25) -* 'f2c' calling convention <1>: Code Gen Options. (line 111) -* Factorial function: GAMMA. (line 6) -* FDATE: FDATE. (line 6) -* FDL, GNU Free Documentation License: GNU Free Documentation License. - (line 6) -* FGET: FGET. (line 6) -* FGETC: FGETC. (line 6) -* file format, fixed: Fortran Dialect Options. - (line 11) -* file format, fixed <1>: Fortran Dialect Options. - (line 57) -* file format, free: Fortran Dialect Options. - (line 11) -* file format, free <1>: Fortran Dialect Options. - (line 70) -* file operation, file number: FNUM. (line 6) -* file operation, flush: FLUSH. (line 6) -* file operation, position: FSEEK. (line 6) -* file operation, position <1>: FTELL. (line 6) -* file operation, read character: FGET. (line 6) -* file operation, read character <1>: FGETC. (line 6) -* file operation, seek: FSEEK. (line 6) -* file operation, write character: FPUT. (line 6) -* file operation, write character <1>: FPUTC. (line 6) -* file system, access mode: ACCESS. (line 6) -* file system, change access mode: CHMOD. (line 6) -* file system, create link: LINK. (line 6) -* file system, create link <1>: SYMLNK. (line 6) -* file system, file creation mask: UMASK. (line 6) -* file system, file status: FSTAT. (line 6) -* file system, file status <1>: LSTAT. (line 6) -* file system, file status <2>: STAT. (line 6) -* file system, hard link: LINK. (line 6) -* file system, remove file: UNLINK. (line 6) -* file system, rename file: RENAME. (line 6) -* file system, soft link: SYMLNK. (line 6) -* flags inquiry function: COMPILER_OPTIONS. (line 6) -* FLOAT: REAL. (line 6) -* floating point, exponent: EXPONENT. (line 6) -* floating point, fraction: FRACTION. (line 6) -* floating point, nearest different: NEAREST. (line 6) -* floating point, relative spacing: RRSPACING. (line 6) -* floating point, relative spacing <1>: SPACING. (line 6) -* floating point, scale: SCALE. (line 6) -* floating point, set exponent: SET_EXPONENT. (line 6) -* FLOOR: FLOOR. (line 6) -* floor: AINT. (line 6) -* floor <1>: FLOOR. (line 6) -* FLUSH: FLUSH. (line 6) -* 'FLUSH' statement: Fortran 2003 status. (line 89) -* FNUM: FNUM. (line 6) -* 'FORMAT': Variable FORMAT expressions. - (line 6) -* Fortran 77: GNU Fortran and G77. (line 6) -* FPP: Preprocessing and conditional compilation. - (line 6) -* FPUT: FPUT. (line 6) -* FPUTC: FPUTC. (line 6) -* FRACTION: FRACTION. (line 6) -* FREE: FREE. (line 6) -* Front-end optimization: Code Gen Options. (line 348) -* FSEEK: FSEEK. (line 6) -* FSTAT: FSTAT. (line 6) -* FTELL: FTELL. (line 6) -* function elimination: Error and Warning Options. - (line 204) -* 'g77': GNU Fortran and G77. (line 6) -* 'g77' calling convention: Code Gen Options. (line 25) -* 'g77' calling convention <1>: Code Gen Options. (line 111) -* GAMMA: GAMMA. (line 6) -* Gamma function: GAMMA. (line 6) -* Gamma function, logarithm of: LOG_GAMMA. (line 6) -* GCC: GNU Fortran and GCC. (line 6) -* GERROR: GERROR. (line 6) -* GETARG: GETARG. (line 6) -* GETCWD: GETCWD. (line 6) -* GETENV: GETENV. (line 6) -* GETGID: GETGID. (line 6) -* GETLOG: GETLOG. (line 6) -* GETPID: GETPID. (line 6) -* GETUID: GETUID. (line 6) -* GET_COMMAND: GET_COMMAND. (line 6) -* GET_COMMAND_ARGUMENT: GET_COMMAND_ARGUMENT. - (line 6) -* GET_ENVIRONMENT_VARIABLE: GET_ENVIRONMENT_VARIABLE. - (line 6) -* GMTIME: GMTIME. (line 6) -* GNU Compiler Collection: GNU Fortran and GCC. (line 6) -* GNU Fortran command options: Invoking GNU Fortran. - (line 6) -* Hollerith constants: Hollerith constants support. - (line 6) -* HOSTNM: HOSTNM. (line 6) -* HUGE: HUGE. (line 6) -* hyperbolic cosine: COSH. (line 6) -* hyperbolic function, cosine: COSH. (line 6) -* hyperbolic function, cosine, inverse: ACOSH. (line 6) -* hyperbolic function, sine: SINH. (line 6) -* hyperbolic function, sine, inverse: ASINH. (line 6) -* hyperbolic function, tangent: TANH. (line 6) -* hyperbolic function, tangent, inverse: ATANH. (line 6) -* hyperbolic sine: SINH. (line 6) -* hyperbolic tangent: TANH. (line 6) -* HYPOT: HYPOT. (line 6) -* I/O item lists: I/O item lists. (line 6) -* IABS: ABS. (line 6) -* IACHAR: IACHAR. (line 6) -* IALL: IALL. (line 6) -* IAND: IAND. (line 6) -* IANY: IANY. (line 6) -* IARGC: IARGC. (line 6) -* IBCLR: IBCLR. (line 6) -* IBITS: IBITS. (line 6) -* IBSET: IBSET. (line 6) -* ICHAR: ICHAR. (line 6) -* IDATE: IDATE. (line 6) -* IDIM: DIM. (line 6) -* IDINT: INT. (line 6) -* IDNINT: NINT. (line 6) -* IEEE, ISNAN: ISNAN. (line 6) -* IEOR: IEOR. (line 6) -* IERRNO: IERRNO. (line 6) -* IFIX: INT. (line 6) -* IMAG: AIMAG. (line 6) -* images, cosubscript to image index conversion: IMAGE_INDEX. (line 6) -* images, index of this image: THIS_IMAGE. (line 6) -* images, number of: NUM_IMAGES. (line 6) -* IMAGE_INDEX: IMAGE_INDEX. (line 6) -* IMAGPART: AIMAG. (line 6) -* 'IMPORT' statement: Fortran 2003 status. (line 120) -* 'INCLUDE' directive: Directory Options. (line 6) -* inclusion, directory search paths for: Directory Options. (line 14) -* INDEX: INDEX intrinsic. (line 6) -* INT: INT. (line 6) -* INT2: INT2. (line 6) -* INT8: INT8. (line 6) -* integer kind: SELECTED_INT_KIND. (line 6) -* Interoperability: Mixed-Language Programming. - (line 6) -* intrinsic: Error and Warning Options. - (line 180) -* intrinsic Modules: Intrinsic Modules. (line 6) -* intrinsic procedures: Intrinsic Procedures. - (line 6) -* Introduction: Top. (line 6) -* inverse hyperbolic cosine: ACOSH. (line 6) -* inverse hyperbolic sine: ASINH. (line 6) -* inverse hyperbolic tangent: ATANH. (line 6) -* 'IOMSG=' specifier: Fortran 2003 status. (line 91) -* IOR: IOR. (line 6) -* 'IOSTAT', end of file: IS_IOSTAT_END. (line 6) -* 'IOSTAT', end of record: IS_IOSTAT_EOR. (line 6) -* IPARITY: IPARITY. (line 6) -* IRAND: IRAND. (line 6) -* ISATTY: ISATTY. (line 6) -* ISHFT: ISHFT. (line 6) -* ISHFTC: ISHFTC. (line 6) -* ISIGN: SIGN. (line 6) -* ISNAN: ISNAN. (line 6) -* 'ISO_FORTRAN_ENV' statement: Fortran 2003 status. (line 128) -* IS_IOSTAT_END: IS_IOSTAT_END. (line 6) -* IS_IOSTAT_EOR: IS_IOSTAT_EOR. (line 6) -* ITIME: ITIME. (line 6) -* KILL: KILL. (line 6) -* KIND: KIND. (line 6) -* kind: KIND Type Parameters. - (line 6) -* kind <1>: KIND. (line 6) -* kind, character: SELECTED_CHAR_KIND. (line 6) -* kind, integer: SELECTED_INT_KIND. (line 6) -* kind, old-style: Old-style kind specifications. - (line 6) -* kind, real: SELECTED_REAL_KIND. (line 6) -* L2 vector norm: NORM2. (line 6) -* language, dialect options: Fortran Dialect Options. - (line 6) -* LBOUND: LBOUND. (line 6) -* LCOBOUND: LCOBOUND. (line 6) -* LEADZ: LEADZ. (line 6) -* left shift, combined: DSHIFTL. (line 6) -* LEN: LEN. (line 6) -* LEN_TRIM: LEN_TRIM. (line 6) -* lexical comparison of strings: LGE. (line 6) -* lexical comparison of strings <1>: LGT. (line 6) -* lexical comparison of strings <2>: LLE. (line 6) -* lexical comparison of strings <3>: LLT. (line 6) -* LGAMMA: LOG_GAMMA. (line 6) -* LGE: LGE. (line 6) -* LGT: LGT. (line 6) -* libf2c calling convention: Code Gen Options. (line 25) -* libf2c calling convention <1>: Code Gen Options. (line 111) -* libgfortran initialization, set_args: _gfortran_set_args. (line 6) -* libgfortran initialization, set_convert: _gfortran_set_convert. - (line 6) -* libgfortran initialization, set_fpe: _gfortran_set_fpe. (line 6) -* libgfortran initialization, set_max_subrecord_length: _gfortran_set_max_subrecord_length. - (line 6) -* libgfortran initialization, set_options: _gfortran_set_options. - (line 6) -* libgfortran initialization, set_record_marker: _gfortran_set_record_marker. - (line 6) -* limits, largest number: HUGE. (line 6) -* limits, smallest number: TINY. (line 6) -* LINK: LINK. (line 6) -* linking, static: Link Options. (line 6) -* LLE: LLE. (line 6) -* LLT: LLT. (line 6) -* LNBLNK: LNBLNK. (line 6) -* LOC: LOC. (line 6) -* location of a variable in memory: LOC. (line 6) -* LOG: LOG. (line 6) -* LOG10: LOG10. (line 6) -* logarithm function: LOG. (line 6) -* logarithm function with base 10: LOG10. (line 6) -* logarithm function, inverse: EXP. (line 6) -* LOGICAL: LOGICAL. (line 6) -* logical and, bitwise: AND. (line 6) -* logical and, bitwise <1>: IAND. (line 6) -* logical exclusive or, bitwise: IEOR. (line 6) -* logical exclusive or, bitwise <1>: XOR. (line 6) -* logical not, bitwise: NOT. (line 6) -* logical or, bitwise: IOR. (line 6) -* logical or, bitwise <1>: OR. (line 6) -* logical, variable representation: Internal representation of LOGICAL variables. - (line 6) -* login name: GETLOG. (line 6) -* LOG_GAMMA: LOG_GAMMA. (line 6) -* LONG: LONG. (line 6) -* LSHIFT: LSHIFT. (line 6) -* LSTAT: LSTAT. (line 6) -* LTIME: LTIME. (line 6) -* MALLOC: MALLOC. (line 6) -* mask, left justified: MASKL. (line 6) -* mask, right justified: MASKR. (line 6) -* MASKL: MASKL. (line 6) -* MASKR: MASKR. (line 6) -* MATMUL: MATMUL. (line 6) -* matrix multiplication: MATMUL. (line 6) -* matrix, transpose: TRANSPOSE. (line 6) -* MAX: MAX. (line 6) -* MAX0: MAX. (line 6) -* MAX1: MAX. (line 6) -* MAXEXPONENT: MAXEXPONENT. (line 6) -* maximum value: MAX. (line 6) -* maximum value <1>: MAXVAL. (line 6) -* MAXLOC: MAXLOC. (line 6) -* MAXVAL: MAXVAL. (line 6) -* MCLOCK: MCLOCK. (line 6) -* MCLOCK8: MCLOCK8. (line 6) -* memory checking: Code Gen Options. (line 142) -* MERGE: MERGE. (line 6) -* MERGE_BITS: MERGE_BITS. (line 6) -* messages, error: Error and Warning Options. - (line 6) -* messages, warning: Error and Warning Options. - (line 6) -* MIN: MIN. (line 6) -* MIN0: MIN. (line 6) -* MIN1: MIN. (line 6) -* MINEXPONENT: MINEXPONENT. (line 6) -* minimum value: MIN. (line 6) -* minimum value <1>: MINVAL. (line 6) -* MINLOC: MINLOC. (line 6) -* MINVAL: MINVAL. (line 6) -* Mixed-language programming: Mixed-Language Programming. - (line 6) -* MOD: MOD. (line 6) -* model representation, base: RADIX. (line 6) -* model representation, epsilon: EPSILON. (line 6) -* model representation, largest number: HUGE. (line 6) -* model representation, maximum exponent: MAXEXPONENT. (line 6) -* model representation, minimum exponent: MINEXPONENT. (line 6) -* model representation, precision: PRECISION. (line 6) -* model representation, radix: RADIX. (line 6) -* model representation, range: RANGE. (line 6) -* model representation, significant digits: DIGITS. (line 6) -* model representation, smallest number: TINY. (line 6) -* module entities: Fortran Dialect Options. - (line 52) -* module search path: Directory Options. (line 14) -* module search path <1>: Directory Options. (line 29) -* module search path <2>: Directory Options. (line 36) -* MODULO: MODULO. (line 6) -* modulo: MODULO. (line 6) -* MOVE_ALLOC: MOVE_ALLOC. (line 6) -* moving allocation: MOVE_ALLOC. (line 6) -* multiply array elements: PRODUCT. (line 6) -* MVBITS: MVBITS. (line 6) -* Namelist: Extensions to namelist. - (line 6) -* natural logarithm function: LOG. (line 6) -* NEAREST: NEAREST. (line 6) -* newline: NEW_LINE. (line 6) -* NEW_LINE: NEW_LINE. (line 6) -* NINT: NINT. (line 6) -* norm, Euclidean: NORM2. (line 6) -* NORM2: NORM2. (line 6) -* NOT: NOT. (line 6) -* NULL: NULL. (line 6) -* NUM_IMAGES: NUM_IMAGES. (line 6) -* OpenMP: Fortran Dialect Options. - (line 90) -* OpenMP <1>: OpenMP. (line 6) -* operators, unary: Unary operators. (line 6) -* options inquiry function: COMPILER_OPTIONS. (line 6) -* options, code generation: Code Gen Options. (line 6) -* options, debugging: Debugging Options. (line 6) -* options, dialect: Fortran Dialect Options. - (line 6) -* options, directory search: Directory Options. (line 6) -* options, errors: Error and Warning Options. - (line 6) -* options, Fortran dialect: Fortran Dialect Options. - (line 11) -* options, 'gfortran' command: Invoking GNU Fortran. - (line 6) -* options, linking: Link Options. (line 6) -* options, negative forms: Invoking GNU Fortran. - (line 13) -* options, preprocessor: Preprocessing Options. - (line 6) -* options, real kind type promotion: Fortran Dialect Options. - (line 148) -* options, run-time: Code Gen Options. (line 6) -* options, runtime: Runtime Options. (line 6) -* options, warnings: Error and Warning Options. - (line 6) -* OR: OR. (line 6) -* output, newline: NEW_LINE. (line 6) -* PACK: PACK. (line 6) -* PARITY: PARITY. (line 6) -* Parity: PARITY. (line 6) -* parity: POPPAR. (line 6) -* paths, search: Directory Options. (line 14) -* paths, search <1>: Directory Options. (line 29) -* paths, search <2>: Directory Options. (line 36) -* PERROR: PERROR. (line 6) -* pointer checking: Code Gen Options. (line 142) -* pointer, C address of pointers: C_F_PROCPOINTER. (line 6) -* pointer, C address of procedures: C_FUNLOC. (line 6) -* pointer, C association status: C_ASSOCIATED. (line 6) -* pointer, convert C to Fortran: C_F_POINTER. (line 6) -* pointer, Cray: Cray pointers. (line 6) -* pointer, cray: FREE. (line 6) -* pointer, cray <1>: MALLOC. (line 6) -* pointer, disassociated: NULL. (line 6) -* pointer, status: ASSOCIATED. (line 6) -* pointer, status <1>: NULL. (line 6) -* POPCNT: POPCNT. (line 6) -* POPPAR: POPPAR. (line 6) -* positive difference: DIM. (line 6) -* PRECISION: PRECISION. (line 6) -* Preprocessing: Preprocessing and conditional compilation. - (line 6) -* preprocessing, assertion: Preprocessing Options. - (line 113) -* preprocessing, assertion <1>: Preprocessing Options. - (line 119) -* preprocessing, define macros: Preprocessing Options. - (line 151) -* preprocessing, define macros <1>: Preprocessing Options. - (line 154) -* preprocessing, include path: Preprocessing Options. - (line 69) -* preprocessing, include path <1>: Preprocessing Options. - (line 76) -* preprocessing, include path <2>: Preprocessing Options. - (line 80) -* preprocessing, include path <3>: Preprocessing Options. - (line 85) -* preprocessing, include path <4>: Preprocessing Options. - (line 89) -* preprocessing, include path <5>: Preprocessing Options. - (line 96) -* preprocessing, keep comments: Preprocessing Options. - (line 122) -* preprocessing, keep comments <1>: Preprocessing Options. - (line 137) -* preprocessing, no linemarkers: Preprocessing Options. - (line 179) -* preprocessing, undefine macros: Preprocessing Options. - (line 185) -* preprocessor: Preprocessing Options. - (line 6) -* preprocessor, debugging: Preprocessing Options. - (line 26) -* preprocessor, debugging <1>: Preprocessing Options. - (line 35) -* preprocessor, debugging <2>: Preprocessing Options. - (line 41) -* preprocessor, debugging <3>: Preprocessing Options. - (line 44) -* preprocessor, debugging <4>: Preprocessing Options. - (line 51) -* preprocessor, disable: Preprocessing Options. - (line 12) -* preprocessor, enable: Preprocessing Options. - (line 12) -* preprocessor, include file handling: Preprocessing and conditional compilation. - (line 6) -* preprocessor, working directory: Preprocessing Options. - (line 55) -* PRESENT: PRESENT. (line 6) -* private: Fortran Dialect Options. - (line 52) -* procedure pointer, convert C to Fortran: C_LOC. (line 6) -* process ID: GETPID. (line 6) -* PRODUCT: PRODUCT. (line 6) -* product, double-precision: DPROD. (line 6) -* product, matrix: MATMUL. (line 6) -* product, vector: DOT_PRODUCT. (line 6) -* program termination: EXIT. (line 6) -* program termination, with core dump: ABORT. (line 6) -* 'PROTECTED' statement: Fortran 2003 status. (line 114) -* 'Q' exponent-letter: 'Q' exponent-letter. (line 6) -* RADIX: RADIX. (line 6) -* radix, real: SELECTED_REAL_KIND. (line 6) -* RAN: RAN. (line 6) -* RAND: RAND. (line 6) -* random number generation: IRAND. (line 6) -* random number generation <1>: RAN. (line 6) -* random number generation <2>: RAND. (line 6) -* random number generation <3>: RANDOM_NUMBER. (line 6) -* random number generation, seeding: RANDOM_SEED. (line 6) -* random number generation, seeding <1>: SRAND. (line 6) -* RANDOM_NUMBER: RANDOM_NUMBER. (line 6) -* RANDOM_SEED: RANDOM_SEED. (line 6) -* RANGE: RANGE. (line 6) -* range checking: Code Gen Options. (line 142) -* RANK: RANK. (line 6) -* rank: RANK. (line 6) -* re-association of parenthesized expressions: Code Gen Options. - (line 325) -* read character, stream mode: FGET. (line 6) -* read character, stream mode <1>: FGETC. (line 6) -* REAL: REAL. (line 6) -* real kind: SELECTED_REAL_KIND. (line 6) -* real number, exponent: EXPONENT. (line 6) -* real number, fraction: FRACTION. (line 6) -* real number, nearest different: NEAREST. (line 6) -* real number, relative spacing: RRSPACING. (line 6) -* real number, relative spacing <1>: SPACING. (line 6) -* real number, scale: SCALE. (line 6) -* real number, set exponent: SET_EXPONENT. (line 6) -* Reallocate the LHS in assignments: Code Gen Options. (line 334) -* Reallocate the LHS in assignments, notification: Error and Warning Options. - (line 208) -* REALPART: REAL. (line 6) -* 'RECORD': STRUCTURE and RECORD. - (line 6) -* Reduction, XOR: PARITY. (line 6) -* remainder: MOD. (line 6) -* RENAME: RENAME. (line 6) -* repacking arrays: Code Gen Options. (line 244) -* REPEAT: REPEAT. (line 6) -* RESHAPE: RESHAPE. (line 6) -* right shift, combined: DSHIFTR. (line 6) -* root: SQRT. (line 6) -* rounding, ceiling: ANINT. (line 6) -* rounding, ceiling <1>: CEILING. (line 6) -* rounding, floor: AINT. (line 6) -* rounding, floor <1>: FLOOR. (line 6) -* rounding, nearest whole number: NINT. (line 6) -* RRSPACING: RRSPACING. (line 6) -* RSHIFT: RSHIFT. (line 6) -* run-time checking: Code Gen Options. (line 142) -* SAME_TYPE_AS: SAME_TYPE_AS. (line 6) -* 'SAVE' statement: Code Gen Options. (line 15) -* SCALE: SCALE. (line 6) -* SCAN: SCAN. (line 6) -* search path: Directory Options. (line 6) -* search paths, for included files: Directory Options. (line 14) -* SECNDS: SECNDS. (line 6) -* SECOND: SECOND. (line 6) -* seeding a random number generator: RANDOM_SEED. (line 6) -* seeding a random number generator <1>: SRAND. (line 6) -* SELECTED_CHAR_KIND: SELECTED_CHAR_KIND. (line 6) -* SELECTED_INT_KIND: SELECTED_INT_KIND. (line 6) -* SELECTED_REAL_KIND: SELECTED_REAL_KIND. (line 6) -* SET_EXPONENT: SET_EXPONENT. (line 6) -* SHAPE: SHAPE. (line 6) -* shift, left: DSHIFTL. (line 6) -* shift, left <1>: SHIFTL. (line 6) -* shift, right: DSHIFTR. (line 6) -* shift, right <1>: SHIFTR. (line 6) -* shift, right with fill: SHIFTA. (line 6) -* SHIFTA: SHIFTA. (line 6) -* SHIFTL: SHIFTL. (line 6) -* SHIFTR: SHIFTR. (line 6) -* SHORT: INT2. (line 6) -* SIGN: SIGN. (line 6) -* sign copying: SIGN. (line 6) -* SIGNAL: SIGNAL. (line 6) -* SIN: SIN. (line 6) -* sine: SIN. (line 6) -* sine, hyperbolic: SINH. (line 6) -* sine, hyperbolic, inverse: ASINH. (line 6) -* sine, inverse: ASIN. (line 6) -* SINH: SINH. (line 6) -* SIZE: SIZE. (line 6) -* size of a variable, in bits: BIT_SIZE. (line 6) -* size of an expression: C_SIZEOF. (line 6) -* size of an expression <1>: SIZEOF. (line 6) -* SIZEOF: SIZEOF. (line 6) -* SLEEP: SLEEP. (line 6) -* SNGL: REAL. (line 6) -* SPACING: SPACING. (line 6) -* SPREAD: SPREAD. (line 6) -* SQRT: SQRT. (line 6) -* square-root: SQRT. (line 6) -* SRAND: SRAND. (line 6) -* Standards: Standards. (line 6) -* STAT: STAT. (line 6) -* statement, 'ENUM': Fortran 2003 status. (line 93) -* statement, 'ENUMERATOR': Fortran 2003 status. (line 93) -* statement, 'FLUSH': Fortran 2003 status. (line 89) -* statement, 'IMPORT': Fortran 2003 status. (line 120) -* statement, 'ISO_FORTRAN_ENV': Fortran 2003 status. (line 128) -* statement, 'PROTECTED': Fortran 2003 status. (line 114) -* statement, 'SAVE': Code Gen Options. (line 15) -* statement, 'USE, INTRINSIC': Fortran 2003 status. (line 128) -* statement, 'VALUE': Fortran 2003 status. (line 116) -* statement, 'VOLATILE': Fortran 2003 status. (line 118) -* storage size: STORAGE_SIZE. (line 6) -* STORAGE_SIZE: STORAGE_SIZE. (line 6) -* 'STREAM' I/O: Fortran 2003 status. (line 103) -* stream mode, read character: FGET. (line 6) -* stream mode, read character <1>: FGETC. (line 6) -* stream mode, write character: FPUT. (line 6) -* stream mode, write character <1>: FPUTC. (line 6) -* string, adjust left: ADJUSTL. (line 6) -* string, adjust right: ADJUSTR. (line 6) -* string, comparison: LGE. (line 6) -* string, comparison <1>: LGT. (line 6) -* string, comparison <2>: LLE. (line 6) -* string, comparison <3>: LLT. (line 6) -* string, concatenate: REPEAT. (line 6) -* string, find missing set: VERIFY. (line 6) -* string, find non-blank character: LNBLNK. (line 6) -* string, find subset: SCAN. (line 6) -* string, find substring: INDEX intrinsic. (line 6) -* string, length: LEN. (line 6) -* string, length, without trailing whitespace: LEN_TRIM. (line 6) -* string, remove trailing whitespace: TRIM. (line 6) -* string, repeat: REPEAT. (line 6) -* strings, varying length: Varying Length Character Strings. - (line 6) -* 'STRUCTURE': STRUCTURE and RECORD. - (line 6) -* structure packing: Code Gen Options. (line 238) -* subscript checking: Code Gen Options. (line 142) -* substring position: INDEX intrinsic. (line 6) -* SUM: SUM. (line 6) -* sum array elements: SUM. (line 6) -* suppressing warnings: Error and Warning Options. - (line 6) -* symbol names: Fortran Dialect Options. - (line 34) -* symbol names, transforming: Code Gen Options. (line 54) -* symbol names, transforming <1>: Code Gen Options. (line 111) -* symbol names, underscores: Code Gen Options. (line 54) -* symbol names, underscores <1>: Code Gen Options. (line 111) -* SYMLNK: SYMLNK. (line 6) -* syntax checking: Error and Warning Options. - (line 33) -* SYSTEM: SYSTEM. (line 6) -* system, error handling: GERROR. (line 6) -* system, error handling <1>: IERRNO. (line 6) -* system, error handling <2>: PERROR. (line 6) -* system, group ID: GETGID. (line 6) -* system, host name: HOSTNM. (line 6) -* system, login name: GETLOG. (line 6) -* system, process ID: GETPID. (line 6) -* system, signal handling: SIGNAL. (line 6) -* system, system call: EXECUTE_COMMAND_LINE. - (line 6) -* system, system call <1>: SYSTEM. (line 6) -* system, terminal: ISATTY. (line 6) -* system, terminal <1>: TTYNAM. (line 6) -* system, user ID: GETUID. (line 6) -* system, working directory: CHDIR. (line 6) -* system, working directory <1>: GETCWD. (line 6) -* SYSTEM_CLOCK: SYSTEM_CLOCK. (line 6) -* tabulators: Error and Warning Options. - (line 168) -* TAN: TAN. (line 6) -* tangent: TAN. (line 6) -* tangent, hyperbolic: TANH. (line 6) -* tangent, hyperbolic, inverse: ATANH. (line 6) -* tangent, inverse: ATAN. (line 6) -* tangent, inverse <1>: ATAN2. (line 6) -* TANH: TANH. (line 6) -* terminate program: EXIT. (line 6) -* terminate program, with core dump: ABORT. (line 6) -* THIS_IMAGE: THIS_IMAGE. (line 6) -* thread-safety, threads: Thread-safety of the runtime library. - (line 6) -* TIME: TIME. (line 6) -* time, clock ticks: MCLOCK. (line 6) -* time, clock ticks <1>: MCLOCK8. (line 6) -* time, clock ticks <2>: SYSTEM_CLOCK. (line 6) -* time, conversion to GMT info: GMTIME. (line 6) -* time, conversion to local time info: LTIME. (line 6) -* time, conversion to string: CTIME. (line 6) -* time, current: DATE_AND_TIME. (line 6) -* time, current <1>: FDATE. (line 6) -* time, current <2>: ITIME. (line 6) -* time, current <3>: TIME. (line 6) -* time, current <4>: TIME8. (line 6) -* time, elapsed: CPU_TIME. (line 6) -* time, elapsed <1>: DTIME. (line 6) -* time, elapsed <2>: ETIME. (line 6) -* time, elapsed <3>: SECNDS. (line 6) -* time, elapsed <4>: SECOND. (line 6) -* TIME8: TIME8. (line 6) -* TINY: TINY. (line 6) -* TR 15581: Fortran 2003 status. (line 98) -* trace: Debugging Options. (line 61) -* TRAILZ: TRAILZ. (line 6) -* TRANSFER: TRANSFER. (line 6) -* transforming symbol names: Code Gen Options. (line 54) -* transforming symbol names <1>: Code Gen Options. (line 111) -* TRANSPOSE: TRANSPOSE. (line 6) -* transpose: TRANSPOSE. (line 6) -* trigonometric function, cosine: COS. (line 6) -* trigonometric function, cosine, inverse: ACOS. (line 6) -* trigonometric function, sine: SIN. (line 6) -* trigonometric function, sine, inverse: ASIN. (line 6) -* trigonometric function, tangent: TAN. (line 6) -* trigonometric function, tangent, inverse: ATAN. (line 6) -* trigonometric function, tangent, inverse <1>: ATAN2. (line 6) -* TRIM: TRIM. (line 6) -* TTYNAM: TTYNAM. (line 6) -* type cast: TRANSFER. (line 6) -* UBOUND: UBOUND. (line 6) -* UCOBOUND: UCOBOUND. (line 6) -* UMASK: UMASK. (line 6) -* underflow: Error and Warning Options. - (line 176) -* underscore: Code Gen Options. (line 54) -* underscore <1>: Code Gen Options. (line 111) -* UNLINK: UNLINK. (line 6) -* UNPACK: UNPACK. (line 6) -* unused dummy argument: Error and Warning Options. - (line 187) -* unused parameter: Error and Warning Options. - (line 191) -* 'USE, INTRINSIC' statement: Fortran 2003 status. (line 128) -* user id: GETUID. (line 6) -* 'VALUE' statement: Fortran 2003 status. (line 116) -* Varying length character strings: Varying Length Character Strings. - (line 6) -* Varying length strings: Varying Length Character Strings. - (line 6) -* vector product: DOT_PRODUCT. (line 6) -* VERIFY: VERIFY. (line 6) -* version of the compiler: COMPILER_VERSION. (line 6) -* 'VOLATILE': Volatile COMMON blocks. - (line 6) -* 'VOLATILE' statement: Fortran 2003 status. (line 118) -* warning, C binding type: Error and Warning Options. - (line 99) -* warnings, aliasing: Error and Warning Options. - (line 69) -* warnings, alignment of 'COMMON' blocks: Error and Warning Options. - (line 198) -* warnings, all: Error and Warning Options. - (line 61) -* warnings, ampersand: Error and Warning Options. - (line 86) -* warnings, array temporaries: Error and Warning Options. - (line 94) -* warnings, character truncation: Error and Warning Options. - (line 106) -* warnings, conversion: Error and Warning Options. - (line 113) -* warnings, conversion <1>: Error and Warning Options. - (line 117) -* warnings, extra: Error and Warning Options. - (line 120) -* warnings, function elimination: Error and Warning Options. - (line 204) -* warnings, implicit interface: Error and Warning Options. - (line 125) -* warnings, implicit procedure: Error and Warning Options. - (line 131) -* warnings, intrinsic: Error and Warning Options. - (line 180) -* warnings, intrinsics of other standards: Error and Warning Options. - (line 135) -* warnings, line truncation: Error and Warning Options. - (line 109) -* warnings, non-standard intrinsics: Error and Warning Options. - (line 135) -* warnings, 'q' exponent-letter: Error and Warning Options. - (line 142) -* warnings, suppressing: Error and Warning Options. - (line 6) -* warnings, suspicious code: Error and Warning Options. - (line 146) -* warnings, tabs: Error and Warning Options. - (line 168) -* warnings, to errors: Error and Warning Options. - (line 237) -* warnings, underflow: Error and Warning Options. - (line 176) -* warnings, unused dummy argument: Error and Warning Options. - (line 187) -* warnings, unused parameter: Error and Warning Options. - (line 191) -* write character, stream mode: FPUT. (line 6) -* write character, stream mode <1>: FPUTC. (line 6) -* XOR: XOR. (line 6) -* XOR reduction: PARITY. (line 6) -* ZABS: ABS. (line 6) -* ZCOS: COS. (line 6) -* zero bits: LEADZ. (line 6) -* zero bits <1>: TRAILZ. (line 6) -* ZEXP: EXP. (line 6) -* ZLOG: LOG. (line 6) -* ZSIN: SIN. (line 6) -* ZSQRT: SQRT. (line 6) - - - -Tag Table: -Node: Top1950 -Node: Introduction3337 -Node: About GNU Fortran4086 -Node: GNU Fortran and GCC8075 -Node: Preprocessing and conditional compilation10189 -Node: GNU Fortran and G7711834 -Node: Project Status12407 -Node: Standards14853 -Node: Varying Length Character Strings15863 -Node: Invoking GNU Fortran16615 -Node: Option Summary18338 -Node: Fortran Dialect Options21744 -Node: Preprocessing Options30410 -Node: Error and Warning Options38651 -Node: Debugging Options48848 -Node: Directory Options52316 -Node: Link Options53751 -Node: Runtime Options54377 -Node: Code Gen Options56284 -Node: Environment Variables72491 -Node: Runtime73096 -Node: TMPDIR74196 -Node: GFORTRAN_STDIN_UNIT74866 -Node: GFORTRAN_STDOUT_UNIT75248 -Node: GFORTRAN_STDERR_UNIT75649 -Node: GFORTRAN_UNBUFFERED_ALL76051 -Node: GFORTRAN_UNBUFFERED_PRECONNECTED76582 -Node: GFORTRAN_SHOW_LOCUS77226 -Node: GFORTRAN_OPTIONAL_PLUS77722 -Node: GFORTRAN_DEFAULT_RECL78198 -Node: GFORTRAN_LIST_SEPARATOR78686 -Node: GFORTRAN_CONVERT_UNIT79295 -Node: GFORTRAN_ERROR_BACKTRACE82150 -Node: Fortran 2003 and 2008 status82707 -Node: Fortran 2003 status82967 -Node: Fortran 2008 status88193 -Node: TS 29113 status93042 -Node: Compiler Characteristics94019 -Node: KIND Type Parameters94555 -Node: Internal representation of LOGICAL variables95983 -Node: Thread-safety of the runtime library96843 -Node: Data consistency and durability98270 -Node: Extensions101324 -Node: Extensions implemented in GNU Fortran101929 -Node: Old-style kind specifications103286 -Node: Old-style variable initialization104388 -Node: Extensions to namelist105700 -Node: X format descriptor without count field108003 -Node: Commas in FORMAT specifications108530 -Node: Missing period in FORMAT specifications109047 -Node: I/O item lists109609 -Node: 'Q' exponent-letter109996 -Node: BOZ literal constants110596 -Node: Real array indices113177 -Node: Unary operators113476 -Node: Implicitly convert LOGICAL and INTEGER values113890 -Node: Hollerith constants support114849 -Node: Cray pointers116621 -Node: CONVERT specifier122068 -Node: OpenMP124063 -Node: Argument list functions126314 -Node: Extensions not implemented in GNU Fortran127919 -Node: STRUCTURE and RECORD128868 -Node: ENCODE and DECODE statements131305 -Node: Variable FORMAT expressions132665 -Node: Alternate complex function syntax133770 -Node: Volatile COMMON blocks134320 -Node: Mixed-Language Programming134797 -Node: Interoperability with C135378 -Node: Intrinsic Types136712 -Node: Derived Types and struct137708 -Node: Interoperable Global Variables139066 -Node: Interoperable Subroutines and Functions140341 -Node: Working with Pointers144135 -Node: Further Interoperability of Fortran with C148611 -Node: GNU Fortran Compiler Directives151965 -Node: Non-Fortran Main Program155217 -Node: _gfortran_set_args157405 -Node: _gfortran_set_options158343 -Node: _gfortran_set_convert161743 -Node: _gfortran_set_record_marker162611 -Node: _gfortran_set_fpe163421 -Node: _gfortran_set_max_subrecord_length164619 -Node: Naming and argument-passing conventions165542 -Node: Naming conventions166261 -Node: Argument passing conventions167733 -Node: Intrinsic Procedures172227 -Node: Introduction to Intrinsics187713 -Node: ABORT190063 -Node: ABS190808 -Node: ACCESS192410 -Node: ACHAR194340 -Node: ACOS195544 -Node: ACOSH196798 -Node: ADJUSTL197793 -Node: ADJUSTR198735 -Node: AIMAG199683 -Node: AINT201055 -Node: ALARM202661 -Node: ALL204293 -Node: ALLOCATED206217 -Node: AND207356 -Node: ANINT208655 -Node: ANY210152 -Node: ASIN212078 -Node: ASINH213321 -Node: ASSOCIATED214326 -Node: ATAN217337 -Node: ATAN2218755 -Node: ATANH220547 -Node: ATOMIC_DEFINE221555 -Node: ATOMIC_REF222631 -Node: BACKTRACE223893 -Node: BESSEL_J0224473 -Node: BESSEL_J1225530 -Node: BESSEL_JN226591 -Node: BESSEL_Y0228416 -Node: BESSEL_Y1229426 -Node: BESSEL_YN230436 -Node: BGE232267 -Node: BGT232959 -Node: BIT_SIZE233609 -Node: BLE234431 -Node: BLT235113 -Node: BTEST235751 -Node: C_ASSOCIATED236636 -Node: C_F_POINTER237847 -Node: C_F_PROCPOINTER239282 -Node: C_FUNLOC240789 -Node: C_LOC242160 -Node: C_SIZEOF243439 -Node: CEILING244852 -Node: CHAR245860 -Node: CHDIR247072 -Node: CHMOD248246 -Node: CMPLX250161 -Node: COMMAND_ARGUMENT_COUNT251614 -Node: COMPILER_OPTIONS252530 -Node: COMPILER_VERSION253556 -Node: COMPLEX254520 -Node: CONJG255659 -Node: COS256715 -Node: COSH258139 -Node: COUNT259321 -Node: CPU_TIME261344 -Node: CSHIFT262701 -Node: CTIME264361 -Node: DATE_AND_TIME266007 -Node: DBLE268487 -Node: DCMPLX269282 -Node: DIGITS270464 -Node: DIM271431 -Node: DOT_PRODUCT272712 -Node: DPROD274355 -Node: DREAL275282 -Node: DSHIFTL275948 -Node: DSHIFTR277281 -Node: DTIME278615 -Node: EOSHIFT281430 -Node: EPSILON283503 -Node: ERF284230 -Node: ERFC285011 -Node: ERFC_SCALED285821 -Node: ETIME286514 -Node: EXECUTE_COMMAND_LINE288762 -Node: EXIT291349 -Node: EXP292225 -Node: EXPONENT293476 -Node: EXTENDS_TYPE_OF294238 -Node: FDATE295094 -Node: FGET296567 -Node: FGETC298392 -Node: FLOOR300198 -Node: FLUSH301185 -Node: FNUM303062 -Node: FPUT303785 -Node: FPUTC305417 -Node: FRACTION307196 -Node: FREE308098 -Node: FSEEK308939 -Node: FSTAT311243 -Node: FTELL312328 -Node: GAMMA313308 -Node: GERROR314360 -Node: GETARG315080 -Node: GET_COMMAND316851 -Node: GET_COMMAND_ARGUMENT318223 -Node: GETCWD320271 -Node: GETENV321251 -Node: GET_ENVIRONMENT_VARIABLE322683 -Node: GETGID324846 -Node: GETLOG325383 -Node: GETPID326245 -Node: GETUID326975 -Node: GMTIME327491 -Node: HOSTNM328975 -Node: HUGE329896 -Node: HYPOT330618 -Node: IACHAR331444 -Node: IALL332612 -Node: IAND334097 -Node: IANY335084 -Node: IARGC336578 -Node: IBCLR337599 -Node: IBITS338261 -Node: IBSET339179 -Node: ICHAR339836 -Node: IDATE342006 -Node: IEOR343036 -Node: IERRNO343916 -Node: IMAGE_INDEX344465 -Node: INDEX intrinsic345493 -Node: INT347019 -Node: INT2348747 -Node: INT8349515 -Node: IOR350230 -Node: IPARITY351086 -Node: IRAND352618 -Node: IS_IOSTAT_END353977 -Node: IS_IOSTAT_EOR355076 -Node: ISATTY356205 -Node: ISHFT356988 -Node: ISHFTC357971 -Node: ISNAN359192 -Node: ITIME359959 -Node: KILL360987 -Node: KIND361896 -Node: LBOUND362742 -Node: LCOBOUND364080 -Node: LEADZ365215 -Node: LEN366076 -Node: LEN_TRIM367372 -Node: LGE368360 -Node: LGT369873 -Node: LINK371351 -Node: LLE372390 -Node: LLT373890 -Node: LNBLNK375361 -Node: LOC376139 -Node: LOG376871 -Node: LOG10378219 -Node: LOG_GAMMA379209 -Node: LOGICAL380311 -Node: LONG381123 -Node: LSHIFT381881 -Node: LSTAT382967 -Node: LTIME384167 -Node: MALLOC385573 -Node: MASKL387035 -Node: MASKR387802 -Node: MATMUL388572 -Node: MAX389670 -Node: MAXEXPONENT391205 -Node: MAXLOC392022 -Node: MAXVAL394047 -Node: MCLOCK395687 -Node: MCLOCK8396710 -Node: MERGE397940 -Node: MERGE_BITS398692 -Node: MIN399557 -Node: MINEXPONENT401095 -Node: MINLOC401726 -Node: MINVAL403751 -Node: MOD405404 -Node: MODULO407173 -Node: MOVE_ALLOC408476 -Node: MVBITS409509 -Node: NEAREST410575 -Node: NEW_LINE411675 -Node: NINT412448 -Node: NORM2413869 -Node: NOT415011 -Node: NULL415595 -Node: NUM_IMAGES416503 -Node: OR417319 -Node: PACK418605 -Node: PARITY420613 -Node: PERROR421834 -Node: POPCNT422459 -Node: POPPAR423331 -Node: PRECISION424385 -Node: PRESENT425272 -Node: PRODUCT426384 -Node: RADIX427918 -Node: RAN428730 -Node: RAND429186 -Node: RANDOM_NUMBER430521 -Node: RANDOM_SEED432250 -Node: RANGE436081 -Node: RANK436762 -Node: REAL437543 -Node: RENAME439340 -Node: REPEAT440362 -Node: RESHAPE441090 -Node: RRSPACING442557 -Node: RSHIFT443250 -Node: SAME_TYPE_AS444390 -Node: SCALE445222 -Node: SCAN446003 -Node: SECNDS447561 -Node: SECOND448653 -Node: SELECTED_CHAR_KIND449529 -Node: SELECTED_INT_KIND451124 -Node: SELECTED_REAL_KIND452301 -Node: SET_EXPONENT454978 -Node: SHAPE455975 -Node: SHIFTA457399 -Node: SHIFTL458363 -Node: SHIFTR459200 -Node: SIGN460038 -Node: SIGNAL461264 -Node: SIN462770 -Node: SINH463812 -Node: SIZE464824 -Node: SIZEOF466143 -Node: SLEEP467620 -Node: SPACING468181 -Node: SPREAD469195 -Node: SQRT470346 -Node: SRAND471678 -Node: STAT472848 -Node: STORAGE_SIZE476016 -Node: SUM476895 -Node: SYMLNK478387 -Node: SYSTEM479522 -Node: SYSTEM_CLOCK480777 -Node: TAN483536 -Node: TANH484524 -Node: THIS_IMAGE485698 -Node: TIME487198 -Node: TIME8488323 -Node: TINY489476 -Node: TRAILZ490077 -Node: TRANSFER490895 -Node: TRANSPOSE492931 -Node: TRIM493621 -Node: TTYNAM494479 -Node: UBOUND495397 -Node: UCOBOUND496787 -Node: UMASK497924 -Node: UNLINK498606 -Node: UNPACK499586 -Node: VERIFY500881 -Node: XOR502610 -Node: Intrinsic Modules503983 -Node: ISO_FORTRAN_ENV504226 -Node: ISO_C_BINDING508394 -Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS512126 -Node: Contributing513671 -Node: Contributors514525 -Node: Projects516156 -Node: Proposed Extensions516962 -Node: Copying518972 -Node: GNU Free Documentation License556517 -Node: Funding581640 -Node: Option Index584166 -Node: Keyword Index599298 - -End Tag Table diff --git a/gcc-4.9/gcc/fortran/gfortran.texi b/gcc-4.9/gcc/fortran/gfortran.texi index 773ec62a5..c852b3aa1 100644 --- a/gcc-4.9/gcc/fortran/gfortran.texi +++ b/gcc-4.9/gcc/fortran/gfortran.texi @@ -531,7 +531,7 @@ The current status of the support is can be found in the @ref{TS 29113 status} sections of the documentation. Additionally, the GNU Fortran compilers supports the OpenMP specification -(version 3.1, @url{http://openmp.org/@/wp/@/openmp-specifications/}). +(version 4.0, @url{http://openmp.org/@/wp/@/openmp-specifications/}). @node Varying Length Character Strings @subsection Varying Length Character Strings @@ -1884,8 +1884,8 @@ It consists of a set of compiler directives, library routines, and environment variables that influence run-time behavior. GNU Fortran strives to be compatible to the -@uref{http://www.openmp.org/mp-documents/spec31.pdf, -OpenMP Application Program Interface v3.1}. +@uref{http://openmp.org/wp/openmp-specifications/, +OpenMP Application Program Interface v4.0}. To enable the processing of the OpenMP directive @code{!$omp} in free-form source code; the @code{c$omp}, @code{*$omp} and @code{!$omp} diff --git a/gcc-4.9/gcc/fortran/gfortranspec.c b/gcc-4.9/gcc/fortran/gfortranspec.c index a6296efbf..cceee6d2d 100644 --- a/gcc-4.9/gcc/fortran/gfortranspec.c +++ b/gcc-4.9/gcc/fortran/gfortranspec.c @@ -73,34 +73,11 @@ static void append_arg (const struct cl_decoded_option *); static unsigned int g77_newargc; static struct cl_decoded_option *g77_new_decoded_options; -/* The path to the spec file. */ -static char *spec_file = NULL; - /* This will be NULL if we encounter a situation where we should not link in the fortran libraries. */ static const char *library = NULL; -/* Return full path name of spec file if it is in DIR, or NULL if - not. */ -static char * -find_spec_file (const char *dir) -{ - const char dirsep_string[] = { DIR_SEPARATOR, '\0' }; - char *spec; - struct stat sb; - - spec = XNEWVEC (char, strlen (dir) + sizeof (SPEC_FILE) + 4); - strcpy (spec, dir); - strcat (spec, dirsep_string); - strcat (spec, SPEC_FILE); - if (!stat (spec, &sb)) - return spec; - free (spec); - return NULL; -} - - /* Return whether strings S1 and S2 are both NULL or both the same string. */ @@ -313,12 +290,6 @@ For more information about these matters, see the file named COPYING\n\n")); cool facility for handling --help and --verbose --help. */ return; - case OPT_L: - if (!spec_file) - spec_file = find_spec_file (decoded_options[i].arg); - break; - - default: break; } @@ -449,12 +420,6 @@ For more information about these matters, see the file named COPYING\n\n")); #endif - /* Read the specs file corresponding to libgfortran. - If we didn't find the spec file on the -L path, we load it - via lang_specific_pre_link. */ - if (spec_file) - append_option (OPT_specs_, spec_file, 1); - if (verbose && g77_new_decoded_options != g77_x_decoded_options) { fprintf (stderr, _("Driving:")); @@ -473,8 +438,7 @@ For more information about these matters, see the file named COPYING\n\n")); int lang_specific_pre_link (void) { - free (spec_file); - if (spec_file == NULL && library) + if (library) do_spec ("%:include(libgfortran.spec)"); return 0; diff --git a/gcc-4.9/gcc/fortran/intrinsic.texi b/gcc-4.9/gcc/fortran/intrinsic.texi index 926ffe954..eb6924c81 100644 --- a/gcc-4.9/gcc/fortran/intrinsic.texi +++ b/gcc-4.9/gcc/fortran/intrinsic.texi @@ -3343,10 +3343,8 @@ end program test_cshift @table @asis @item @emph{Description}: @code{CTIME} converts a system time value, such as returned by -@code{TIME8}, to a string. Unless the application has called -@code{setlocale}, the output will be in the default locale, of length -24 and of the form @samp{Sat Aug 19 18:13:14 1995}. In other locales, -a longer string may result. +@code{TIME8}, to a string. The output will be of the form @samp{Sat +Aug 19 18:13:14 1995}. This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit. @@ -13210,8 +13208,7 @@ named constants: @code{OMP_LIB} provides the scalar default-integer named constant @code{openmp_version} with a value of the form @var{yyyymm}, where @code{yyyy} is the year and @var{mm} the month -of the OpenMP version; for OpenMP v3.1 the value is @code{201107} -and for OpenMP v4.0 the value is @code{201307}. +of the OpenMP version; for OpenMP v4.0 the value is @code{201307}. The following scalar integer named constants of the kind @code{omp_sched_kind}: diff --git a/gcc-4.9/gcc/fortran/match.c b/gcc-4.9/gcc/fortran/match.c index 4c4609401..b3f47a8e7 100644 --- a/gcc-4.9/gcc/fortran/match.c +++ b/gcc-4.9/gcc/fortran/match.c @@ -2595,7 +2595,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) && o != NULL && o->state == COMP_OMP_STRUCTURED_BLOCK && (o->head->op == EXEC_OMP_DO - || o->head->op == EXEC_OMP_PARALLEL_DO)) + || o->head->op == EXEC_OMP_PARALLEL_DO + || o->head->op == EXEC_OMP_SIMD + || o->head->op == EXEC_OMP_DO_SIMD + || o->head->op == EXEC_OMP_PARALLEL_DO_SIMD)) { int collapse = 1; gcc_assert (o->head->next != NULL @@ -4564,6 +4567,30 @@ gfc_free_namelist (gfc_namelist *name) } +/* Free an OpenMP namelist structure. */ + +void +gfc_free_omp_namelist (gfc_omp_namelist *name) +{ + gfc_omp_namelist *n; + + for (; name; name = n) + { + gfc_free_expr (name->expr); + if (name->udr) + { + if (name->udr->combiner) + gfc_free_statement (name->udr->combiner); + if (name->udr->initializer) + gfc_free_statement (name->udr->initializer); + free (name->udr); + } + n = name->next; + free (name); + } +} + + /* Match a NAMELIST statement. */ match diff --git a/gcc-4.9/gcc/fortran/match.h b/gcc-4.9/gcc/fortran/match.h index 385e84020..d07db11ef 100644 --- a/gcc-4.9/gcc/fortran/match.h +++ b/gcc-4.9/gcc/fortran/match.h @@ -126,20 +126,46 @@ gfc_common_head *gfc_get_common (const char *, int); match gfc_match_omp_eos (void); match gfc_match_omp_atomic (void); match gfc_match_omp_barrier (void); +match gfc_match_omp_cancel (void); +match gfc_match_omp_cancellation_point (void); match gfc_match_omp_critical (void); +match gfc_match_omp_declare_reduction (void); +match gfc_match_omp_declare_simd (void); +match gfc_match_omp_declare_target (void); +match gfc_match_omp_distribute (void); +match gfc_match_omp_distribute_parallel_do (void); +match gfc_match_omp_distribute_parallel_do_simd (void); +match gfc_match_omp_distribute_simd (void); match gfc_match_omp_do (void); +match gfc_match_omp_do_simd (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_do_simd (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_simd (void); match gfc_match_omp_single (void); +match gfc_match_omp_target (void); +match gfc_match_omp_target_data (void); +match gfc_match_omp_target_teams (void); +match gfc_match_omp_target_teams_distribute (void); +match gfc_match_omp_target_teams_distribute_parallel_do (void); +match gfc_match_omp_target_teams_distribute_parallel_do_simd (void); +match gfc_match_omp_target_teams_distribute_simd (void); +match gfc_match_omp_target_update (void); match gfc_match_omp_task (void); +match gfc_match_omp_taskgroup (void); match gfc_match_omp_taskwait (void); match gfc_match_omp_taskyield (void); +match gfc_match_omp_teams (void); +match gfc_match_omp_teams_distribute (void); +match gfc_match_omp_teams_distribute_parallel_do (void); +match gfc_match_omp_teams_distribute_parallel_do_simd (void); +match gfc_match_omp_teams_distribute_simd (void); match gfc_match_omp_threadprivate (void); match gfc_match_omp_workshare (void); match gfc_match_omp_end_nowait (void); diff --git a/gcc-4.9/gcc/fortran/module.c b/gcc-4.9/gcc/fortran/module.c index 52fdebe34..2bfe17784 100644 --- a/gcc-4.9/gcc/fortran/module.c +++ b/gcc-4.9/gcc/fortran/module.c @@ -83,6 +83,7 @@ along with GCC; see the file COPYING3. If not see /* Don't put any single quote (') in MOD_VERSION, if you want it to be recognized. */ #define MOD_VERSION "12" +#define MOD_VERSION_OMP4 "12 OpenMP 4" /* Structure that describes a position within a module file. */ @@ -196,6 +197,7 @@ static char* module_content; static long module_pos; static int module_line, module_column, only_flag; static int prev_module_line, prev_module_column; +static bool module_omp4; static enum { IO_INPUT, IO_OUTPUT } @@ -1877,7 +1879,7 @@ typedef enum AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP, AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION, AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER, - AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY + AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET } ab_attribute; @@ -1932,6 +1934,7 @@ static const mstring attr_bits[] = minit ("CLASS_POINTER", AB_CLASS_POINTER), minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE), minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY), + minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET), minit (NULL, -1) }; @@ -2110,6 +2113,8 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits); if (attr->vtab) MIO_NAME (ab_attribute) (AB_VTAB, attr_bits); + if (attr->omp_declare_target) + MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits); mio_rparen (); @@ -2273,6 +2278,9 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_VTAB: attr->vtab = 1; break; + case AB_OMP_DECLARE_TARGET: + attr->omp_declare_target = 1; + break; } } } @@ -3130,6 +3138,7 @@ static const mstring intrinsics[] = minit ("LE", INTRINSIC_LE_OS), minit ("NOT", INTRINSIC_NOT), minit ("PARENTHESES", INTRINSIC_PARENTHESES), + minit ("USER", INTRINSIC_USER), minit (NULL, -1) }; @@ -3166,7 +3175,8 @@ fix_mio_expr (gfc_expr *e) && !e->symtree->n.sym->attr.dummy) e->symtree = ns_st; } - else if (e->expr_type == EXPR_FUNCTION && e->value.function.name) + else if (e->expr_type == EXPR_FUNCTION + && (e->value.function.name || e->value.function.isym)) { gfc_symbol *sym; @@ -3281,6 +3291,32 @@ mio_expr (gfc_expr **ep) mio_expr (&e->value.op.op2); break; + case INTRINSIC_USER: + /* INTRINSIC_USER should not appear in resolved expressions, + though for UDRs we need to stream unresolved ones. */ + if (iomode == IO_OUTPUT) + write_atom (ATOM_STRING, e->value.op.uop->name); + else + { + char *name = read_string (); + const char *uop_name = find_use_name (name, true); + if (uop_name == NULL) + { + size_t len = strlen (name); + char *name2 = XCNEWVEC (char, len + 2); + memcpy (name2, name, len); + name2[len] = ' '; + name2[len + 1] = '\0'; + free (name); + uop_name = name = name2; + } + e->value.op.uop = gfc_get_uop (uop_name); + free (name); + } + mio_expr (&e->value.op.op1); + mio_expr (&e->value.op.op2); + break; + default: bad_module ("Bad operator"); } @@ -3299,6 +3335,8 @@ mio_expr (gfc_expr **ep) flag = 1; else if (e->ref) flag = 2; + else if (e->value.function.isym == NULL) + flag = 3; else flag = 0; mio_integer (&flag); @@ -3310,6 +3348,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: write_atom (ATOM_STRING, e->value.function.isym->name); } @@ -3317,7 +3357,10 @@ mio_expr (gfc_expr **ep) else { require_atom (ATOM_STRING); - e->value.function.name = gfc_get_string (atom_string); + if (atom_string[0] == '\0') + e->value.function.name = NULL; + else + e->value.function.name = gfc_get_string (atom_string); free (atom_string); mio_integer (&flag); @@ -3329,6 +3372,8 @@ mio_expr (gfc_expr **ep) case 2: mio_ref_list (&e->ref); break; + case 3: + break; default: require_atom (ATOM_STRING); e->value.function.isym = gfc_find_function (atom_string); @@ -3790,6 +3835,203 @@ mio_full_f2k_derived (gfc_symbol *sym) mio_rparen (); } +static const mstring omp_declare_simd_clauses[] = +{ + minit ("INBRANCH", 0), + minit ("NOTINBRANCH", 1), + minit ("SIMDLEN", 2), + minit ("UNIFORM", 3), + minit ("LINEAR", 4), + minit ("ALIGNED", 5), + minit (NULL, -1) +}; + +/* Handle !$omp declare simd. */ + +static void +mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp) +{ + if (iomode == IO_OUTPUT) + { + if (*odsp == NULL) + return; + } + else if (peek_atom () != ATOM_LPAREN) + return; + + gfc_omp_declare_simd *ods = *odsp; + + mio_lparen (); + if (iomode == IO_OUTPUT) + { + write_atom (ATOM_NAME, "OMP_DECLARE_SIMD"); + if (ods->clauses) + { + gfc_omp_namelist *n; + + if (ods->clauses->inbranch) + mio_name (0, omp_declare_simd_clauses); + if (ods->clauses->notinbranch) + mio_name (1, omp_declare_simd_clauses); + if (ods->clauses->simdlen_expr) + { + mio_name (2, omp_declare_simd_clauses); + mio_expr (&ods->clauses->simdlen_expr); + } + for (n = ods->clauses->lists[OMP_LIST_UNIFORM]; n; n = n->next) + { + mio_name (3, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + } + for (n = ods->clauses->lists[OMP_LIST_LINEAR]; n; n = n->next) + { + mio_name (4, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + } + for (n = ods->clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + mio_name (5, omp_declare_simd_clauses); + mio_symbol_ref (&n->sym); + mio_expr (&n->expr); + } + } + } + else + { + gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL }; + + require_atom (ATOM_NAME); + *odsp = ods = gfc_get_omp_declare_simd (); + ods->where = gfc_current_locus; + ods->proc_name = ns->proc_name; + if (peek_atom () == ATOM_NAME) + { + ods->clauses = gfc_get_omp_clauses (); + ptrs[0] = &ods->clauses->lists[OMP_LIST_UNIFORM]; + ptrs[1] = &ods->clauses->lists[OMP_LIST_LINEAR]; + ptrs[2] = &ods->clauses->lists[OMP_LIST_ALIGNED]; + } + while (peek_atom () == ATOM_NAME) + { + gfc_omp_namelist *n; + int t = mio_name (0, omp_declare_simd_clauses); + + switch (t) + { + case 0: ods->clauses->inbranch = true; break; + case 1: ods->clauses->notinbranch = true; break; + case 2: mio_expr (&ods->clauses->simdlen_expr); break; + case 3: + case 4: + case 5: + *ptrs[t - 3] = n = gfc_get_omp_namelist (); + ptrs[t - 3] = &n->next; + mio_symbol_ref (&n->sym); + if (t != 3) + mio_expr (&n->expr); + break; + } + } + } + + mio_omp_declare_simd (ns, &ods->next); + + mio_rparen (); +} + + +static const mstring omp_declare_reduction_stmt[] = +{ + minit ("ASSIGN", 0), + minit ("CALL", 1), + minit (NULL, -1) +}; + + +static void +mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2, + gfc_namespace *ns, bool is_initializer) +{ + if (iomode == IO_OUTPUT) + { + if ((*sym1)->module == NULL) + { + (*sym1)->module = module_name; + (*sym2)->module = module_name; + } + mio_symbol_ref (sym1); + mio_symbol_ref (sym2); + if (ns->code->op == EXEC_ASSIGN) + { + mio_name (0, omp_declare_reduction_stmt); + mio_expr (&ns->code->expr1); + mio_expr (&ns->code->expr2); + } + else + { + int flag; + mio_name (1, omp_declare_reduction_stmt); + mio_symtree_ref (&ns->code->symtree); + mio_actual_arglist (&ns->code->ext.actual); + + flag = ns->code->resolved_isym != NULL; + mio_integer (&flag); + if (flag) + write_atom (ATOM_STRING, ns->code->resolved_isym->name); + else + mio_symbol_ref (&ns->code->resolved_sym); + } + } + else + { + pointer_info *p1 = mio_symbol_ref (sym1); + pointer_info *p2 = mio_symbol_ref (sym2); + gfc_symbol *sym; + gcc_assert (p1->u.rsym.ns == p2->u.rsym.ns); + gcc_assert (p1->u.rsym.sym == NULL); + /* Add hidden symbols to the symtree. */ + pointer_info *q = get_integer (p1->u.rsym.ns); + q->u.pointer = (void *) ns; + sym = gfc_new_symbol (is_initializer ? "omp_priv" : "omp_out", ns); + sym->ts = udr->ts; + sym->module = gfc_get_string (p1->u.rsym.module); + associate_integer_pointer (p1, sym); + sym->attr.omp_udr_artificial_var = 1; + gcc_assert (p2->u.rsym.sym == NULL); + sym = gfc_new_symbol (is_initializer ? "omp_orig" : "omp_in", ns); + sym->ts = udr->ts; + sym->module = gfc_get_string (p2->u.rsym.module); + associate_integer_pointer (p2, sym); + sym->attr.omp_udr_artificial_var = 1; + if (mio_name (0, omp_declare_reduction_stmt) == 0) + { + ns->code = gfc_get_code (EXEC_ASSIGN); + mio_expr (&ns->code->expr1); + mio_expr (&ns->code->expr2); + } + else + { + int flag; + ns->code = gfc_get_code (EXEC_CALL); + mio_symtree_ref (&ns->code->symtree); + mio_actual_arglist (&ns->code->ext.actual); + + mio_integer (&flag); + if (flag) + { + require_atom (ATOM_STRING); + ns->code->resolved_isym = gfc_find_subroutine (atom_string); + free (atom_string); + } + else + mio_symbol_ref (&ns->code->resolved_sym); + } + ns->code->loc = gfc_current_locus; + ns->omp_udr_ns = 1; + } +} + /* Unlike most other routines, the address of the symbol node is already fixed on input and the name/module has already been filled in. @@ -3864,6 +4106,17 @@ mio_symbol (gfc_symbol *sym) if (sym->attr.flavor == FL_DERIVED) mio_integer (&(sym->hash_value)); + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->entries == NULL) + { + if (module_omp4) + mio_omp_declare_simd (sym->formal_ns, + &sym->formal_ns->omp_declare_simd); + else if (iomode == IO_OUTPUT) + gcc_assert (sym->formal_ns->omp_declare_simd == NULL); + } + mio_rparen (); } @@ -4343,6 +4596,119 @@ load_derived_extensions (void) } +/* This function loads OpenMP user defined reductions. */ +static void +load_omp_udrs (void) +{ + mio_lparen (); + while (peek_atom () != ATOM_RPAREN) + { + const char *name, *newname; + char *altname; + gfc_typespec ts; + gfc_symtree *st; + gfc_omp_reduction_op rop = OMP_REDUCTION_USER; + + mio_lparen (); + mio_pool_string (&name); + mio_typespec (&ts); + if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0) + { + const char *p = name + sizeof ("operator ") - 1; + if (strcmp (p, "+") == 0) + rop = OMP_REDUCTION_PLUS; + else if (strcmp (p, "*") == 0) + rop = OMP_REDUCTION_TIMES; + else if (strcmp (p, "-") == 0) + rop = OMP_REDUCTION_MINUS; + else if (strcmp (p, ".and.") == 0) + rop = OMP_REDUCTION_AND; + else if (strcmp (p, ".or.") == 0) + rop = OMP_REDUCTION_OR; + else if (strcmp (p, ".eqv.") == 0) + rop = OMP_REDUCTION_EQV; + else if (strcmp (p, ".neqv.") == 0) + rop = OMP_REDUCTION_NEQV; + } + altname = NULL; + if (rop == OMP_REDUCTION_USER && name[0] == '.') + { + size_t len = strlen (name + 1); + altname = XALLOCAVEC (char, len); + gcc_assert (name[len] == '.'); + memcpy (altname, name + 1, len - 1); + altname[len - 1] = '\0'; + } + newname = name; + if (rop == OMP_REDUCTION_USER) + newname = find_use_name (altname ? altname : name, !!altname); + else if (only_flag && find_use_operator ((gfc_intrinsic_op) rop) == NULL) + newname = NULL; + if (newname == NULL) + { + skip_list (1); + continue; + } + if (altname && newname != altname) + { + size_t len = strlen (newname); + altname = XALLOCAVEC (char, len + 3); + altname[0] = '.'; + memcpy (altname + 1, newname, len); + altname[len + 1] = '.'; + altname[len + 2] = '\0'; + name = gfc_get_string (altname); + } + st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); + gfc_omp_udr *udr = gfc_omp_udr_find (st, &ts); + if (udr) + { + require_atom (ATOM_INTEGER); + pointer_info *p = get_integer (atom_int); + if (strcmp (p->u.rsym.module, udr->omp_out->module)) + { + gfc_error ("Ambiguous !$OMP DECLARE REDUCTION from " + "module %s at %L", + p->u.rsym.module, &gfc_current_locus); + gfc_error ("Previous !$OMP DECLARE REDUCTION from module " + "%s at %L", + udr->omp_out->module, &udr->where); + } + skip_list (1); + continue; + } + udr = gfc_get_omp_udr (); + udr->name = name; + udr->rop = rop; + udr->ts = ts; + udr->where = gfc_current_locus; + udr->combiner_ns = gfc_get_namespace (gfc_current_ns, 1); + udr->combiner_ns->proc_name = gfc_current_ns->proc_name; + mio_omp_udr_expr (udr, &udr->omp_out, &udr->omp_in, udr->combiner_ns, + false); + if (peek_atom () != ATOM_RPAREN) + { + udr->initializer_ns = gfc_get_namespace (gfc_current_ns, 1); + udr->initializer_ns->proc_name = gfc_current_ns->proc_name; + mio_omp_udr_expr (udr, &udr->omp_priv, &udr->omp_orig, + udr->initializer_ns, true); + } + if (st) + { + udr->next = st->n.omp_udr; + st->n.omp_udr = udr; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udr_root, name); + st->n.omp_udr = udr; + } + mio_rparen (); + } + mio_rparen (); +} + + /* Recursive function to traverse the pointer_info tree and load a needed symbol. We return nonzero if we load a symbol and stop the traversal, because the act of loading can alter the tree. */ @@ -4530,7 +4896,7 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info) static void read_module (void) { - module_locus operator_interfaces, user_operators, extensions; + module_locus operator_interfaces, user_operators, extensions, omp_udrs; const char *p; char name[GFC_MAX_SYMBOL_LEN + 1]; int i; @@ -4554,6 +4920,11 @@ read_module (void) get_module_locus (&extensions); skip_list (); + /* Skip OpenMP UDRs. */ + get_module_locus (&omp_udrs); + if (module_omp4) + skip_list (); + mio_lparen (); /* Create the fixup nodes for all the symbols. */ @@ -4819,6 +5190,13 @@ read_module (void) load_commons (); load_equiv (); + if (module_omp4) + { + /* Load OpenMP user defined reductions. */ + set_module_locus (&omp_udrs); + load_omp_udrs (); + } + /* At this point, we read those symbols that are needed but haven't been loaded yet. If one symbol requires another, the other gets marked as NEEDED if its previous state was UNUSED. */ @@ -5197,6 +5575,80 @@ write_symbol0 (gfc_symtree *st) } +static void +write_omp_udr (gfc_omp_udr *udr) +{ + switch (udr->rop) + { + case OMP_REDUCTION_USER: + /* Non-operators can't be used outside of the module. */ + if (udr->name[0] != '.') + return; + else + { + gfc_symtree *st; + size_t len = strlen (udr->name + 1); + char *name = XALLOCAVEC (char, len); + memcpy (name, udr->name, len - 1); + name[len - 1] = '\0'; + st = gfc_find_symtree (gfc_current_ns->uop_root, name); + /* If corresponding user operator is private, don't write + the UDR. */ + if (st != NULL) + { + gfc_user_op *uop = st->n.uop; + if (!check_access (uop->access, uop->ns->default_access)) + return; + } + } + break; + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + /* If corresponding operator is private, don't write the UDR. */ + if (!check_access (gfc_current_ns->operator_access[udr->rop], + gfc_current_ns->default_access)) + return; + break; + default: + break; + } + if (udr->ts.type == BT_DERIVED || udr->ts.type == BT_CLASS) + { + /* If derived type is private, don't write the UDR. */ + if (!gfc_check_symbol_access (udr->ts.u.derived)) + return; + } + + mio_lparen (); + mio_pool_string (&udr->name); + mio_typespec (&udr->ts); + mio_omp_udr_expr (udr, &udr->omp_out, &udr->omp_in, udr->combiner_ns, false); + if (udr->initializer_ns) + mio_omp_udr_expr (udr, &udr->omp_priv, &udr->omp_orig, + udr->initializer_ns, true); + mio_rparen (); +} + + +static void +write_omp_udrs (gfc_symtree *st) +{ + if (st == NULL) + return; + + write_omp_udrs (st->left); + gfc_omp_udr *udr; + for (udr = st->n.omp_udr; udr; udr = udr->next) + write_omp_udr (udr); + write_omp_udrs (st->right); +} + + /* Type for the temporary tree used when writing secondary symbols. */ struct sorted_pointer_info @@ -5445,6 +5897,17 @@ write_module (void) write_char ('\n'); write_char ('\n'); + if (module_omp4) + { + mio_lparen (); + write_omp_udrs (gfc_current_ns->omp_udr_root); + mio_rparen (); + write_char ('\n'); + write_char ('\n'); + } + else + gcc_assert (gfc_current_ns->omp_udr_root == NULL); + /* Write symbol information. First we traverse all symbols in the primary namespace, writing those that need to be written. Sometimes writing one symbol will cause another to need to be @@ -5513,6 +5976,21 @@ read_crc32_from_module_file (const char* filename, uLong* crc) } +/* Set module_omp4 if any symbol has !$OMP DECLARE SIMD directives. */ + +static void +find_omp_declare_simd (gfc_symtree *st) +{ + gfc_symbol *sym = st->n.sym; + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->omp_declare_simd) + module_omp4 = true; + else if (sym->attr.omp_declare_target) + module_omp4 = true; +} + + /* Given module, dump it to disk. If there was an error while processing the module, dump_flag will be set to zero and we delete the module file, even if it was already there. */ @@ -5555,6 +6033,12 @@ gfc_dump_module (const char *name, int dump_flag) if (gfc_cpp_makedep ()) gfc_cpp_add_target (filename); + module_omp4 = false; + if (gfc_current_ns->omp_udr_root) + module_omp4 = true; + else + gfc_traverse_symtree (gfc_current_ns->sym_root, find_omp_declare_simd); + /* Write the module to the temporary file. */ module_fp = gzopen (filename_tmp, "w"); if (module_fp == NULL) @@ -5562,7 +6046,7 @@ gfc_dump_module (const char *name, int dump_flag) filename_tmp, xstrerror (errno)); gzprintf (module_fp, "GFORTRAN module version '%s' created from %s\n", - MOD_VERSION, gfc_source_file); + module_omp4 ? MOD_VERSION_OMP4 : MOD_VERSION, gfc_source_file); /* Write the module itself. */ iomode = IO_OUTPUT; @@ -6353,6 +6837,8 @@ gfc_use_module (gfc_use_list *module) read_module_to_tmpbuf (); gzclose (module_fp); + module_omp4 = false; + /* Skip the first line of the module, after checking that this is a gfortran module file. */ line = 0; @@ -6372,11 +6858,15 @@ gfc_use_module (gfc_use_list *module) if (strcmp (atom_name, " version") != 0 || module_char () != ' ' || parse_atom () != ATOM_STRING - || strcmp (atom_string, MOD_VERSION)) + || (strcmp (atom_string, MOD_VERSION) + && strcmp (atom_string, MOD_VERSION_OMP4))) gfc_fatal_error ("Cannot read module file '%s' opened at %C," " because it was created by a different" " version of GNU Fortran", filename); + if (strcmp (atom_string, MOD_VERSION_OMP4) == 0) + module_omp4 = true; + free (atom_string); } diff --git a/gcc-4.9/gcc/fortran/openmp.c b/gcc-4.9/gcc/fortran/openmp.c index dff3ab1ad..68ba70f7e 100644 --- a/gcc-4.9/gcc/fortran/openmp.c +++ b/gcc-4.9/gcc/fortran/openmp.c @@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see #include "coretypes.h" #include "flags.h" #include "gfortran.h" +#include "arith.h" #include "match.h" #include "parse.h" #include "pointer-set.h" @@ -69,19 +70,111 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->final_expr); gfc_free_expr (c->num_threads); gfc_free_expr (c->chunk_size); + gfc_free_expr (c->safelen_expr); + gfc_free_expr (c->simdlen_expr); + gfc_free_expr (c->num_teams); + gfc_free_expr (c->device); + gfc_free_expr (c->thread_limit); + gfc_free_expr (c->dist_chunk_size); for (i = 0; i < OMP_LIST_NUM; i++) - gfc_free_namelist (c->lists[i]); + gfc_free_omp_namelist (c->lists[i]); free (c); } +/* Free an !$omp declare simd construct list. */ + +void +gfc_free_omp_declare_simd (gfc_omp_declare_simd *ods) +{ + if (ods) + { + gfc_free_omp_clauses (ods->clauses); + free (ods); + } +} + +void +gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *list) +{ + while (list) + { + gfc_omp_declare_simd *current = list; + list = list->next; + gfc_free_omp_declare_simd (current); + } +} + +/* Free an !$omp declare reduction. */ + +void +gfc_free_omp_udr (gfc_omp_udr *omp_udr) +{ + if (omp_udr) + { + gfc_free_omp_udr (omp_udr->next); + gfc_free_namespace (omp_udr->combiner_ns); + if (omp_udr->initializer_ns) + gfc_free_namespace (omp_udr->initializer_ns); + free (omp_udr); + } +} + + +static gfc_omp_udr * +gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts) +{ + gfc_symtree *st; + + if (ns == NULL) + ns = gfc_current_ns; + do + { + gfc_omp_udr *omp_udr; + + st = gfc_find_symtree (ns->omp_udr_root, name); + if (st != NULL) + for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) + if (ts == NULL) + return omp_udr; + else if (gfc_compare_types (&omp_udr->ts, ts)) + { + if (ts->type == BT_CHARACTER) + { + if (omp_udr->ts.u.cl->length == NULL) + return omp_udr; + if (ts->u.cl->length == NULL) + continue; + if (gfc_compare_expr (omp_udr->ts.u.cl->length, + ts->u.cl->length, + INTRINSIC_EQ) != 0) + continue; + } + return omp_udr; + } + + /* Don't escape an interface block. */ + if (ns && !ns->has_import_set + && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY) + break; + + ns = ns->parent; + } + while (ns != NULL); + + return NULL; +} + + /* 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_match_omp_variable_list (const char *str, gfc_omp_namelist **list, + bool allow_common, bool *end_colon = NULL, + gfc_omp_namelist ***headp = NULL, + bool allow_sections = false) { - gfc_namelist *head, *tail, *p; - locus old_loc; + gfc_omp_namelist *head, *tail, *p; + locus old_loc, cur_loc; char n[GFC_MAX_SYMBOL_LEN+1]; gfc_symbol *sym; match m; @@ -97,12 +190,29 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, for (;;) { + cur_loc = gfc_current_locus; m = gfc_match_symbol (&sym, 1); switch (m) { case MATCH_YES: + gfc_expr *expr; + expr = NULL; + if (allow_sections && gfc_peek_ascii_char () == '(') + { + gfc_current_locus = cur_loc; + m = gfc_match_variable (&expr, 0); + switch (m) + { + case MATCH_ERROR: + goto cleanup; + case MATCH_NO: + goto syntax; + default: + break; + } + } gfc_set_sym_referenced (sym); - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); if (head == NULL) head = tail = p; else @@ -111,6 +221,7 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, tail = tail->next; } tail->sym = sym; + tail->expr = expr; goto next_item; case MATCH_NO: break; @@ -136,7 +247,7 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, for (sym = st->n.common->head; sym; sym = sym->common_next) { gfc_set_sym_referenced (sym); - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); if (head == NULL) head = tail = p; else @@ -148,6 +259,11 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, } next_item: + if (end_colon && gfc_match_char (':') == MATCH_YES) + { + *end_colon = true; + break; + } if (gfc_match_char (')') == MATCH_YES) break; if (gfc_match_char (',') != MATCH_YES) @@ -158,43 +274,61 @@ gfc_match_omp_variable_list (const char *str, gfc_namelist **list, list = &(*list)->next; *list = head; + if (headp) + *headp = list; return MATCH_YES; syntax: gfc_error ("Syntax error in OpenMP variable list at %C"); cleanup: - gfc_free_namelist (head); + gfc_free_omp_namelist (head); gfc_current_locus = old_loc; return MATCH_ERROR; } -#define OMP_CLAUSE_PRIVATE (1 << 0) -#define OMP_CLAUSE_FIRSTPRIVATE (1 << 1) -#define OMP_CLAUSE_LASTPRIVATE (1 << 2) -#define OMP_CLAUSE_COPYPRIVATE (1 << 3) -#define OMP_CLAUSE_SHARED (1 << 4) -#define OMP_CLAUSE_COPYIN (1 << 5) -#define OMP_CLAUSE_REDUCTION (1 << 6) -#define OMP_CLAUSE_IF (1 << 7) -#define OMP_CLAUSE_NUM_THREADS (1 << 8) -#define OMP_CLAUSE_SCHEDULE (1 << 9) -#define OMP_CLAUSE_DEFAULT (1 << 10) -#define OMP_CLAUSE_ORDERED (1 << 11) -#define OMP_CLAUSE_COLLAPSE (1 << 12) -#define OMP_CLAUSE_UNTIED (1 << 13) -#define OMP_CLAUSE_FINAL (1 << 14) -#define OMP_CLAUSE_MERGEABLE (1 << 15) +#define OMP_CLAUSE_PRIVATE (1U << 0) +#define OMP_CLAUSE_FIRSTPRIVATE (1U << 1) +#define OMP_CLAUSE_LASTPRIVATE (1U << 2) +#define OMP_CLAUSE_COPYPRIVATE (1U << 3) +#define OMP_CLAUSE_SHARED (1U << 4) +#define OMP_CLAUSE_COPYIN (1U << 5) +#define OMP_CLAUSE_REDUCTION (1U << 6) +#define OMP_CLAUSE_IF (1U << 7) +#define OMP_CLAUSE_NUM_THREADS (1U << 8) +#define OMP_CLAUSE_SCHEDULE (1U << 9) +#define OMP_CLAUSE_DEFAULT (1U << 10) +#define OMP_CLAUSE_ORDERED (1U << 11) +#define OMP_CLAUSE_COLLAPSE (1U << 12) +#define OMP_CLAUSE_UNTIED (1U << 13) +#define OMP_CLAUSE_FINAL (1U << 14) +#define OMP_CLAUSE_MERGEABLE (1U << 15) +#define OMP_CLAUSE_ALIGNED (1U << 16) +#define OMP_CLAUSE_DEPEND (1U << 17) +#define OMP_CLAUSE_INBRANCH (1U << 18) +#define OMP_CLAUSE_LINEAR (1U << 19) +#define OMP_CLAUSE_NOTINBRANCH (1U << 20) +#define OMP_CLAUSE_PROC_BIND (1U << 21) +#define OMP_CLAUSE_SAFELEN (1U << 22) +#define OMP_CLAUSE_SIMDLEN (1U << 23) +#define OMP_CLAUSE_UNIFORM (1U << 24) +#define OMP_CLAUSE_DEVICE (1U << 25) +#define OMP_CLAUSE_MAP (1U << 26) +#define OMP_CLAUSE_TO (1U << 27) +#define OMP_CLAUSE_FROM (1U << 28) +#define OMP_CLAUSE_NUM_TEAMS (1U << 29) +#define OMP_CLAUSE_THREAD_LIMIT (1U << 30) +#define OMP_CLAUSE_DIST_SCHEDULE (1U << 31) /* 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_match_omp_clauses (gfc_omp_clauses **cp, unsigned int mask, + bool first = true, bool needs_space = true) { gfc_omp_clauses *c = gfc_get_omp_clauses (); locus old_loc; - bool needs_space = true, first = true; *cp = NULL; while (1) @@ -251,22 +385,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) if ((mask & OMP_CLAUSE_REDUCTION) && gfc_match ("reduction ( ") == MATCH_YES) { - int reduction = OMP_LIST_NUM; - char buffer[GFC_MAX_SYMBOL_LEN + 1]; + gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; + char buffer[GFC_MAX_SYMBOL_LEN + 3]; if (gfc_match_char ('+') == MATCH_YES) - reduction = OMP_LIST_PLUS; + rop = OMP_REDUCTION_PLUS; else if (gfc_match_char ('*') == MATCH_YES) - reduction = OMP_LIST_MULT; + rop = OMP_REDUCTION_TIMES; else if (gfc_match_char ('-') == MATCH_YES) - reduction = OMP_LIST_SUB; + rop = OMP_REDUCTION_MINUS; else if (gfc_match (".and.") == MATCH_YES) - reduction = OMP_LIST_AND; + rop = OMP_REDUCTION_AND; else if (gfc_match (".or.") == MATCH_YES) - reduction = OMP_LIST_OR; + rop = OMP_REDUCTION_OR; else if (gfc_match (".eqv.") == MATCH_YES) - reduction = OMP_LIST_EQV; + rop = OMP_REDUCTION_EQV; else if (gfc_match (".neqv.") == MATCH_YES) - reduction = OMP_LIST_NEQV; + rop = OMP_REDUCTION_NEQV; + if (rop != OMP_REDUCTION_NONE) + snprintf (buffer, sizeof buffer, + "operator %s", gfc_op2string ((gfc_intrinsic_op) rop)); + else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES) + { + buffer[0] = '.'; + strcat (buffer, "."); + } else if (gfc_match_name (buffer) == MATCH_YES) { gfc_symbol *sym; @@ -294,40 +436,64 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) || 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; + n = NULL; } else n = sym->name; } - if (strcmp (n, "max") == 0) - reduction = OMP_LIST_MAX; + if (n == NULL) + rop = OMP_REDUCTION_NONE; + else if (strcmp (n, "max") == 0) + rop = OMP_REDUCTION_MAX; else if (strcmp (n, "min") == 0) - reduction = OMP_LIST_MIN; + rop = OMP_REDUCTION_MIN; else if (strcmp (n, "iand") == 0) - reduction = OMP_LIST_IAND; + rop = OMP_REDUCTION_IAND; else if (strcmp (n, "ior") == 0) - reduction = OMP_LIST_IOR; + rop = OMP_REDUCTION_IOR; else if (strcmp (n, "ieor") == 0) - reduction = OMP_LIST_IEOR; - if (reduction != OMP_LIST_NUM + rop = OMP_REDUCTION_IEOR; + if (rop != OMP_REDUCTION_NONE && sym != NULL && ! sym->attr.intrinsic && ! sym->attr.use_assoc && ((sym->attr.flavor == FL_UNKNOWN - && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL)) + && !gfc_add_flavor (&sym->attr, FL_PROCEDURE, + sym->name, NULL)) || !gfc_add_intrinsic (&sym->attr, NULL))) + rop = OMP_REDUCTION_NONE; + } + gfc_omp_udr *udr = gfc_find_omp_udr (gfc_current_ns, buffer, NULL); + gfc_omp_namelist **head = NULL; + if (rop == OMP_REDUCTION_NONE && udr) + rop = OMP_REDUCTION_USER; + + if (gfc_match_omp_variable_list (" :", + &c->lists[OMP_LIST_REDUCTION], + false, NULL, &head) == MATCH_YES) + { + gfc_omp_namelist *n; + if (rop == OMP_REDUCTION_NONE) { - gfc_free_omp_clauses (c); - return MATCH_ERROR; + n = *head; + *head = NULL; + gfc_error_now ("!$OMP DECLARE REDUCTION %s not found " + "at %L", buffer, &old_loc); + gfc_free_omp_namelist (n); } + else + for (n = *head; n; n = n->next) + { + n->u.reduction_op = rop; + if (udr) + { + n->udr = gfc_get_omp_namelist_udr (); + n->udr->udr = udr; + } + } + continue; } - if (reduction != OMP_LIST_NUM - && gfc_match_omp_variable_list (" :", &c->lists[reduction], - false) - == MATCH_YES) - continue; else gfc_current_locus = old_loc; } @@ -419,6 +585,188 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) continue; } } + if ((mask & OMP_CLAUSE_INBRANCH) && !c->inbranch && !c->notinbranch + && gfc_match ("inbranch") == MATCH_YES) + { + c->inbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_NOTINBRANCH) && !c->notinbranch && !c->inbranch + && gfc_match ("notinbranch") == MATCH_YES) + { + c->notinbranch = needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_PROC_BIND) + && c->proc_bind == OMP_PROC_BIND_UNKNOWN) + { + if (gfc_match ("proc_bind ( master )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_MASTER; + else if (gfc_match ("proc_bind ( spread )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_SPREAD; + else if (gfc_match ("proc_bind ( close )") == MATCH_YES) + c->proc_bind = OMP_PROC_BIND_CLOSE; + if (c->proc_bind != OMP_PROC_BIND_UNKNOWN) + continue; + } + if ((mask & OMP_CLAUSE_SAFELEN) && c->safelen_expr == NULL + && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_SIMDLEN) && c->simdlen_expr == NULL + && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_UNIFORM) + && gfc_match_omp_variable_list ("uniform (", + &c->lists[OMP_LIST_UNIFORM], false) + == MATCH_YES) + continue; + bool end_colon = false; + gfc_omp_namelist **head = NULL; + old_loc = gfc_current_locus; + if ((mask & OMP_CLAUSE_ALIGNED) + && gfc_match_omp_variable_list ("aligned (", + &c->lists[OMP_LIST_ALIGNED], false, + &end_colon, &head) + == MATCH_YES) + { + gfc_expr *alignment = NULL; + gfc_omp_namelist *n; + + if (end_colon + && gfc_match (" %e )", &alignment) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + for (n = *head; n; n = n->next) + if (n->next && alignment) + n->expr = gfc_copy_expr (alignment); + else + n->expr = alignment; + continue; + } + end_colon = false; + head = NULL; + old_loc = gfc_current_locus; + if ((mask & OMP_CLAUSE_LINEAR) + && gfc_match_omp_variable_list ("linear (", + &c->lists[OMP_LIST_LINEAR], false, + &end_colon, &head) + == MATCH_YES) + { + gfc_expr *step = NULL; + + if (end_colon + && gfc_match (" %e )", &step) != MATCH_YES) + { + gfc_free_omp_namelist (*head); + gfc_current_locus = old_loc; + *head = NULL; + break; + } + else if (!end_colon) + { + step = gfc_get_constant_expr (BT_INTEGER, + gfc_default_integer_kind, + &old_loc); + mpz_set_si (step->value.integer, 1); + } + (*head)->expr = step; + continue; + } + if ((mask & OMP_CLAUSE_DEPEND) + && gfc_match ("depend ( ") == MATCH_YES) + { + match m = MATCH_YES; + gfc_omp_depend_op depend_op = OMP_DEPEND_OUT; + if (gfc_match ("inout") == MATCH_YES) + depend_op = OMP_DEPEND_INOUT; + else if (gfc_match ("in") == MATCH_YES) + depend_op = OMP_DEPEND_IN; + else if (gfc_match ("out") == MATCH_YES) + depend_op = OMP_DEPEND_OUT; + else + m = MATCH_NO; + head = NULL; + if (m == MATCH_YES + && gfc_match_omp_variable_list (" : ", + &c->lists[OMP_LIST_DEPEND], + false, NULL, &head, true) + == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.depend_op = depend_op; + continue; + } + else + gfc_current_locus = old_loc; + } + if ((mask & OMP_CLAUSE_DIST_SCHEDULE) + && c->dist_sched_kind == OMP_SCHED_NONE + && gfc_match ("dist_schedule ( static") == MATCH_YES) + { + match m = MATCH_NO; + c->dist_sched_kind = OMP_SCHED_STATIC; + m = gfc_match (" , %e )", &c->dist_chunk_size); + if (m != MATCH_YES) + m = gfc_match_char (')'); + if (m != MATCH_YES) + { + c->dist_sched_kind = OMP_SCHED_NONE; + gfc_current_locus = old_loc; + } + else + continue; + } + if ((mask & OMP_CLAUSE_NUM_TEAMS) && c->num_teams == NULL + && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_DEVICE) && c->device == NULL + && gfc_match ("device ( %e )", &c->device) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_THREAD_LIMIT) && c->thread_limit == NULL + && gfc_match ("thread_limit ( %e )", &c->thread_limit) == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_MAP) + && gfc_match ("map ( ") == MATCH_YES) + { + gfc_omp_map_op map_op = OMP_MAP_TOFROM; + if (gfc_match ("alloc : ") == MATCH_YES) + map_op = OMP_MAP_ALLOC; + else if (gfc_match ("tofrom : ") == MATCH_YES) + map_op = OMP_MAP_TOFROM; + else if (gfc_match ("to : ") == MATCH_YES) + map_op = OMP_MAP_TO; + else if (gfc_match ("from : ") == MATCH_YES) + map_op = OMP_MAP_FROM; + head = NULL; + if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP], + false, NULL, &head, true) + == MATCH_YES) + { + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + n->u.map_op = map_op; + continue; + } + else + gfc_current_locus = old_loc; + } + if ((mask & OMP_CLAUSE_TO) + && gfc_match_omp_variable_list ("to (", + &c->lists[OMP_LIST_TO], false, + NULL, &head, true) + == MATCH_YES) + continue; + if ((mask & OMP_CLAUSE_FROM) + && gfc_match_omp_variable_list ("from (", + &c->lists[OMP_LIST_FROM], false, + NULL, &head, true) + == MATCH_YES) + continue; break; } @@ -436,7 +784,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) #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) + | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PROC_BIND) +#define OMP_DECLARE_SIMD_CLAUSES \ + (OMP_CLAUSE_SIMDLEN | OMP_CLAUSE_LINEAR | OMP_CLAUSE_UNIFORM \ + | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH | OMP_CLAUSE_NOTINBRANCH) #define OMP_DO_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ @@ -444,107 +795,633 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask) #define OMP_SECTIONS_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) +#define OMP_SIMD_CLAUSES \ + (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ + | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN | OMP_CLAUSE_LINEAR \ + | OMP_CLAUSE_ALIGNED) #define OMP_TASK_CLAUSES \ (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED \ - | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE) + | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_DEPEND) +#define OMP_TARGET_CLAUSES \ + (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) +#define OMP_TARGET_DATA_CLAUSES \ + (OMP_CLAUSE_DEVICE | OMP_CLAUSE_MAP | OMP_CLAUSE_IF) +#define OMP_TARGET_UPDATE_CLAUSES \ + (OMP_CLAUSE_DEVICE | OMP_CLAUSE_IF | OMP_CLAUSE_TO | OMP_CLAUSE_FROM) +#define OMP_TEAMS_CLAUSES \ + (OMP_CLAUSE_NUM_TEAMS | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_DEFAULT \ + | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED \ + | OMP_CLAUSE_REDUCTION) +#define OMP_DISTRIBUTE_CLAUSES \ + (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_COLLAPSE \ + | OMP_CLAUSE_DIST_SCHEDULE) -match -gfc_match_omp_parallel (void) -{ - gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES) - return MATCH_ERROR; - new_st.op = EXEC_OMP_PARALLEL; - new_st.ext.omp_clauses = c; - return MATCH_YES; -} - -match -gfc_match_omp_task (void) +static match +match_omp (gfc_exec_op op, unsigned int mask) { gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES) != MATCH_YES) + if (gfc_match_omp_clauses (&c, mask) != MATCH_YES) return MATCH_ERROR; - new_st.op = EXEC_OMP_TASK; + new_st.op = op; new_st.ext.omp_clauses = c; return MATCH_YES; } match -gfc_match_omp_taskwait (void) +gfc_match_omp_critical (void) { + char n[GFC_MAX_SYMBOL_LEN+1]; + + if (gfc_match (" ( %n )", n) != MATCH_YES) + n[0] = '\0'; if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after TASKWAIT clause at %C"); + gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); return MATCH_ERROR; } - new_st.op = EXEC_OMP_TASKWAIT; - new_st.ext.omp_clauses = NULL; + new_st.op = EXEC_OMP_CRITICAL; + new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; return MATCH_YES; } match -gfc_match_omp_taskyield (void) +gfc_match_omp_distribute (void) { - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after TASKYIELD clause at %C"); - return MATCH_ERROR; - } - new_st.op = EXEC_OMP_TASKYIELD; - new_st.ext.omp_clauses = NULL; - return MATCH_YES; + return match_omp (EXEC_OMP_DISTRIBUTE, OMP_DISTRIBUTE_CLAUSES); } match -gfc_match_omp_critical (void) +gfc_match_omp_distribute_parallel_do (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO, + OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES); +} - if (gfc_match (" ( %n )", n) != MATCH_YES) - n[0] = '\0'; + +match +gfc_match_omp_distribute_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD, + (OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED); +} + + +match +gfc_match_omp_distribute_simd (void) +{ + return match_omp (EXEC_OMP_DISTRIBUTE_SIMD, + OMP_DISTRIBUTE_CLAUSES | OMP_SIMD_CLAUSES); +} + + +match +gfc_match_omp_do (void) +{ + return match_omp (EXEC_OMP_DO, OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_do_simd (void) +{ + return match_omp (EXEC_OMP_DO_SIMD, ((OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED)); +} + + +match +gfc_match_omp_flush (void) +{ + gfc_omp_namelist *list = NULL; + gfc_match_omp_variable_list (" (", &list, true); if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); + gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); + gfc_free_omp_namelist (list); return MATCH_ERROR; } - new_st.op = EXEC_OMP_CRITICAL; - new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; + new_st.op = EXEC_OMP_FLUSH; + new_st.ext.omp_namelist = list; return MATCH_YES; } match -gfc_match_omp_do (void) +gfc_match_omp_declare_simd (void) { + locus where = gfc_current_locus; + gfc_symbol *proc_name; gfc_omp_clauses *c; - if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES) + gfc_omp_declare_simd *ods; + + if (gfc_match (" ( %s ) ", &proc_name) != MATCH_YES) return MATCH_ERROR; - new_st.op = EXEC_OMP_DO; - new_st.ext.omp_clauses = c; + + if (gfc_match_omp_clauses (&c, OMP_DECLARE_SIMD_CLAUSES, true, + false) != MATCH_YES) + return MATCH_ERROR; + + ods = gfc_get_omp_declare_simd (); + ods->where = where; + ods->proc_name = proc_name; + ods->clauses = c; + ods->next = gfc_current_ns->omp_declare_simd; + gfc_current_ns->omp_declare_simd = ods; return MATCH_YES; } +static bool +match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) +{ + match m; + locus old_loc = gfc_current_locus; + char sname[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + gfc_namespace *ns = gfc_current_ns; + gfc_expr *lvalue = NULL, *rvalue = NULL; + gfc_symtree *st; + gfc_actual_arglist *arglist; + + m = gfc_match (" %v =", &lvalue); + if (m != MATCH_YES) + gfc_current_locus = old_loc; + else + { + m = gfc_match (" %e )", &rvalue); + if (m == MATCH_YES) + { + ns->code = gfc_get_code (EXEC_ASSIGN); + ns->code->expr1 = lvalue; + ns->code->expr2 = rvalue; + ns->code->loc = old_loc; + return true; + } + + gfc_current_locus = old_loc; + gfc_free_expr (lvalue); + } + + m = gfc_match (" %n", sname); + if (m != MATCH_YES) + return false; + + if (strcmp (sname, omp_sym1->name) == 0 + || strcmp (sname, omp_sym2->name) == 0) + return false; + + gfc_current_ns = ns->parent; + if (gfc_get_ha_sym_tree (sname, &st)) + return false; + + sym = st->n.sym; + if (sym->attr.flavor != FL_PROCEDURE + && sym->attr.flavor != FL_UNKNOWN) + return false; + + if (!sym->attr.generic + && !sym->attr.subroutine + && !sym->attr.function) + { + if (!(sym->attr.external && !sym->attr.referenced)) + { + /* ...create a symbol in this scope... */ + if (sym->ns != gfc_current_ns + && gfc_get_sym_tree (sname, NULL, &st, false) == 1) + return false; + + if (sym != st->n.sym) + sym = st->n.sym; + } + + /* ...and then to try to make the symbol into a subroutine. */ + if (!gfc_add_subroutine (&sym->attr, sym->name, NULL)) + return false; + } + + gfc_set_sym_referenced (sym); + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () != '(') + return false; + + gfc_current_ns = ns; + m = gfc_match_actual_arglist (1, &arglist); + if (m != MATCH_YES) + return false; + + if (gfc_match_char (')') != MATCH_YES) + return false; + + ns->code = gfc_get_code (EXEC_CALL); + ns->code->symtree = st; + ns->code->ext.actual = arglist; + ns->code->loc = old_loc; + return true; +} + +static bool +gfc_omp_udr_predef (gfc_omp_reduction_op rop, const char *name, + gfc_typespec *ts, const char **n) +{ + if (!gfc_numeric_ts (ts) && ts->type != BT_LOGICAL) + return false; + + switch (rop) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_TIMES: + return ts->type != BT_LOGICAL; + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + return ts->type == BT_LOGICAL; + case OMP_REDUCTION_USER: + if (name[0] != '.' && (ts->type == BT_INTEGER || ts->type == BT_REAL)) + { + gfc_symbol *sym; + + gfc_find_symbol (name, 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) + *n = NULL; + else + *n = sym->name; + } + else + *n = name; + if (*n + && (strcmp (*n, "max") == 0 || strcmp (*n, "min") == 0)) + return true; + else if (*n + && ts->type == BT_INTEGER + && (strcmp (*n, "iand") == 0 + || strcmp (*n, "ior") == 0 + || strcmp (*n, "ieor") == 0)) + return true; + } + break; + default: + break; + } + return false; +} + +gfc_omp_udr * +gfc_omp_udr_find (gfc_symtree *st, gfc_typespec *ts) +{ + gfc_omp_udr *omp_udr; + + if (st == NULL) + return NULL; + + for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) + if (omp_udr->ts.type == ts->type + || ((omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS) + && (ts->type == BT_DERIVED && ts->type == BT_CLASS))) + { + if (omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS) + { + if (strcmp (omp_udr->ts.u.derived->name, ts->u.derived->name) == 0) + return omp_udr; + } + else if (omp_udr->ts.kind == ts->kind) + { + if (omp_udr->ts.type == BT_CHARACTER) + { + if (omp_udr->ts.u.cl->length == NULL + || ts->u.cl->length == NULL) + return omp_udr; + if (omp_udr->ts.u.cl->length->expr_type != EXPR_CONSTANT) + return omp_udr; + if (ts->u.cl->length->expr_type != EXPR_CONSTANT) + return omp_udr; + if (omp_udr->ts.u.cl->length->ts.type != BT_INTEGER) + return omp_udr; + if (ts->u.cl->length->ts.type != BT_INTEGER) + return omp_udr; + if (gfc_compare_expr (omp_udr->ts.u.cl->length, + ts->u.cl->length, INTRINSIC_EQ) != 0) + continue; + } + return omp_udr; + } + } + return NULL; +} + match -gfc_match_omp_flush (void) +gfc_match_omp_declare_reduction (void) { - gfc_namelist *list = NULL; - gfc_match_omp_variable_list (" (", &list, true); + match m; + gfc_intrinsic_op op; + char name[GFC_MAX_SYMBOL_LEN + 3]; + auto_vec<gfc_typespec, 5> tss; + gfc_typespec ts; + unsigned int i; + gfc_symtree *st; + locus where = gfc_current_locus; + locus end_loc = gfc_current_locus; + bool end_loc_set = false; + gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; + + if (gfc_match_char ('(') != MATCH_YES) + return MATCH_ERROR; + + m = gfc_match (" %o : ", &op); + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (m == MATCH_YES) + { + snprintf (name, sizeof name, "operator %s", gfc_op2string (op)); + rop = (gfc_omp_reduction_op) op; + } + else + { + m = gfc_match_defined_op_name (name + 1, 1); + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (m == MATCH_YES) + { + name[0] = '.'; + strcat (name, "."); + if (gfc_match (" : ") != MATCH_YES) + return MATCH_ERROR; + } + else + { + if (gfc_match (" %n : ", name) != MATCH_YES) + return MATCH_ERROR; + } + rop = OMP_REDUCTION_USER; + } + + m = gfc_match_type_spec (&ts); + if (m != MATCH_YES) + return MATCH_ERROR; + /* Treat len=: the same as len=*. */ + if (ts.type == BT_CHARACTER) + ts.deferred = false; + tss.safe_push (ts); + + while (gfc_match_char (',') == MATCH_YES) + { + m = gfc_match_type_spec (&ts); + if (m != MATCH_YES) + return MATCH_ERROR; + tss.safe_push (ts); + } + if (gfc_match_char (':') != MATCH_YES) + return MATCH_ERROR; + + st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); + for (i = 0; i < tss.length (); i++) + { + gfc_symtree *omp_out, *omp_in; + gfc_symtree *omp_priv = NULL, *omp_orig = NULL; + gfc_namespace *combiner_ns, *initializer_ns = NULL; + gfc_omp_udr *prev_udr, *omp_udr; + const char *predef_name = NULL; + + omp_udr = gfc_get_omp_udr (); + omp_udr->name = gfc_get_string (name); + omp_udr->rop = rop; + omp_udr->ts = tss[i]; + omp_udr->where = where; + + gfc_current_ns = combiner_ns = gfc_get_namespace (gfc_current_ns, 1); + combiner_ns->proc_name = combiner_ns->parent->proc_name; + + gfc_get_sym_tree ("omp_out", combiner_ns, &omp_out, false); + gfc_get_sym_tree ("omp_in", combiner_ns, &omp_in, false); + combiner_ns->omp_udr_ns = 1; + omp_out->n.sym->ts = tss[i]; + omp_in->n.sym->ts = tss[i]; + omp_out->n.sym->attr.omp_udr_artificial_var = 1; + omp_in->n.sym->attr.omp_udr_artificial_var = 1; + omp_out->n.sym->attr.flavor = FL_VARIABLE; + omp_in->n.sym->attr.flavor = FL_VARIABLE; + gfc_commit_symbols (); + omp_udr->combiner_ns = combiner_ns; + omp_udr->omp_out = omp_out->n.sym; + omp_udr->omp_in = omp_in->n.sym; + + locus old_loc = gfc_current_locus; + + if (!match_udr_expr (omp_out, omp_in)) + { + syntax: + gfc_current_locus = old_loc; + gfc_current_ns = combiner_ns->parent; + gfc_free_omp_udr (omp_udr); + return MATCH_ERROR; + } + + if (gfc_match (" initializer ( ") == MATCH_YES) + { + gfc_current_ns = combiner_ns->parent; + initializer_ns = gfc_get_namespace (gfc_current_ns, 1); + gfc_current_ns = initializer_ns; + initializer_ns->proc_name = initializer_ns->parent->proc_name; + + gfc_get_sym_tree ("omp_priv", initializer_ns, &omp_priv, false); + gfc_get_sym_tree ("omp_orig", initializer_ns, &omp_orig, false); + initializer_ns->omp_udr_ns = 1; + omp_priv->n.sym->ts = tss[i]; + omp_orig->n.sym->ts = tss[i]; + omp_priv->n.sym->attr.omp_udr_artificial_var = 1; + omp_orig->n.sym->attr.omp_udr_artificial_var = 1; + omp_priv->n.sym->attr.flavor = FL_VARIABLE; + omp_orig->n.sym->attr.flavor = FL_VARIABLE; + gfc_commit_symbols (); + omp_udr->initializer_ns = initializer_ns; + omp_udr->omp_priv = omp_priv->n.sym; + omp_udr->omp_orig = omp_orig->n.sym; + + if (!match_udr_expr (omp_priv, omp_orig)) + goto syntax; + } + + gfc_current_ns = combiner_ns->parent; + if (!end_loc_set) + { + end_loc_set = true; + end_loc = gfc_current_locus; + } + gfc_current_locus = old_loc; + + prev_udr = gfc_omp_udr_find (st, &tss[i]); + if (gfc_omp_udr_predef (rop, name, &tss[i], &predef_name) + /* Don't error on !$omp declare reduction (min : integer : ...) + just yet, there could be integer :: min afterwards, + making it valid. When the UDR is resolved, we'll get + to it again. */ + && (rop != OMP_REDUCTION_USER || name[0] == '.')) + { + if (predef_name) + gfc_error_now ("Redefinition of predefined %s " + "!$OMP DECLARE REDUCTION at %L", + predef_name, &where); + else + gfc_error_now ("Redefinition of predefined " + "!$OMP DECLARE REDUCTION at %L", &where); + } + else if (prev_udr) + { + gfc_error_now ("Redefinition of !$OMP DECLARE REDUCTION at %L", + &where); + gfc_error_now ("Previous !$OMP DECLARE REDUCTION at %L", + &prev_udr->where); + } + else if (st) + { + omp_udr->next = st->n.omp_udr; + st->n.omp_udr = omp_udr; + } + else + { + st = gfc_new_symtree (&gfc_current_ns->omp_udr_root, name); + st->n.omp_udr = omp_udr; + } + } + + if (end_loc_set) + { + gfc_current_locus = end_loc; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after !$OMP DECLARE REDUCTION at %C"); + gfc_current_locus = where; + return MATCH_ERROR; + } + + return MATCH_YES; + } + gfc_clear_error (); + return MATCH_ERROR; +} + + +match +gfc_match_omp_declare_target (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 (gfc_current_ns->proc_name + && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY + && m == MATCH_YES) + { + gfc_error ("Only the !$OMP DECLARE TARGET form without " + "list is allowed in interface block at %C"); + goto cleanup; + } + + if (m == MATCH_NO + && gfc_current_ns->proc_name + && gfc_match_omp_eos () == MATCH_YES) + { + if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr, + gfc_current_ns->proc_name->name, + &old_loc)) + goto cleanup; + return MATCH_YES; + } + + if (m != MATCH_YES) + return m; + + for (;;) + { + m = gfc_match_symbol (&sym, 0); + switch (m) + { + case MATCH_YES: + if (sym->attr.in_common) + gfc_error_now ("OMP DECLARE TARGET on a variable at %C is an " + "element of a COMMON block"); + else if (!gfc_add_omp_declare_target (&sym->attr, sym->name, + &sym->declared_at)) + 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->omp_declare_target = 1; + for (sym = st->n.common->head; sym; sym = sym->common_next) + if (!gfc_add_omp_declare_target (&sym->attr, sym->name, + &sym->declared_at)) + goto cleanup; + + next_item: + if (gfc_match_char (')') == MATCH_YES) + break; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); - gfc_free_namelist (list); - return MATCH_ERROR; + gfc_error ("Unexpected junk after !$OMP DECLARE TARGET at %C"); + goto cleanup; } - new_st.op = EXEC_OMP_FLUSH; - new_st.ext.omp_namelist = list; return MATCH_YES; + +syntax: + gfc_error ("Syntax error in !$OMP DECLARE TARGET list at %C"); + +cleanup: + gfc_current_locus = old_loc; + return MATCH_ERROR; } @@ -605,6 +1482,12 @@ gfc_match_omp_threadprivate (void) goto syntax; } + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after OMP THREADPRIVATE at %C"); + goto cleanup; + } + return MATCH_YES; syntax: @@ -617,69 +1500,213 @@ cleanup: match +gfc_match_omp_parallel (void) +{ + return match_omp (EXEC_OMP_PARALLEL, OMP_PARALLEL_CLAUSES); +} + + +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; + return match_omp (EXEC_OMP_PARALLEL_DO, + OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_PARALLEL_DO_SIMD, + (OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED); } 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; + return match_omp (EXEC_OMP_PARALLEL_SECTIONS, + OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES); } 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; + return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES); } 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; + return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES); +} + + +match +gfc_match_omp_simd (void) +{ + return match_omp (EXEC_OMP_SIMD, OMP_SIMD_CLAUSES); } 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_omp (EXEC_OMP_SINGLE, + OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE); +} + + +match +gfc_match_omp_task (void) +{ + return match_omp (EXEC_OMP_TASK, OMP_TASK_CLAUSES); +} + + +match +gfc_match_omp_taskwait (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKWAIT clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKWAIT; + new_st.ext.omp_clauses = NULL; return MATCH_YES; } match +gfc_match_omp_taskyield (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after TASKYIELD clause at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKYIELD; + new_st.ext.omp_clauses = NULL; + return MATCH_YES; +} + + +match +gfc_match_omp_target (void) +{ + return match_omp (EXEC_OMP_TARGET, OMP_TARGET_CLAUSES); +} + + +match +gfc_match_omp_target_data (void) +{ + return match_omp (EXEC_OMP_TARGET_DATA, OMP_TARGET_DATA_CLAUSES); +} + + +match +gfc_match_omp_target_teams (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES); +} + + +match +gfc_match_omp_target_teams_distribute (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES); +} + + +match +gfc_match_omp_target_teams_distribute_parallel_do (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_target_teams_distribute_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + (OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_PARALLEL_CLAUSES + | OMP_DO_CLAUSES | OMP_SIMD_CLAUSES) + & ~OMP_CLAUSE_ORDERED); +} + + +match +gfc_match_omp_target_teams_distribute_simd (void) +{ + return match_omp (EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD, + OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES + | OMP_DISTRIBUTE_CLAUSES | OMP_SIMD_CLAUSES); +} + + +match +gfc_match_omp_target_update (void) +{ + return match_omp (EXEC_OMP_TARGET_UPDATE, OMP_TARGET_UPDATE_CLAUSES); +} + + +match +gfc_match_omp_teams (void) +{ + return match_omp (EXEC_OMP_TEAMS, OMP_TEAMS_CLAUSES); +} + + +match +gfc_match_omp_teams_distribute (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE, + OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES); +} + + +match +gfc_match_omp_teams_distribute_parallel_do (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO, + OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES); +} + + +match +gfc_match_omp_teams_distribute_parallel_do_simd (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, + (OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES + | OMP_SIMD_CLAUSES) & ~OMP_CLAUSE_ORDERED); +} + + +match +gfc_match_omp_teams_distribute_simd (void) +{ + return match_omp (EXEC_OMP_TEAMS_DISTRIBUTE_SIMD, + OMP_TEAMS_CLAUSES | OMP_DISTRIBUTE_CLAUSES + | OMP_SIMD_CLAUSES); +} + + +match gfc_match_omp_workshare (void) { if (gfc_match_omp_eos () != MATCH_YES) @@ -725,20 +1752,44 @@ match gfc_match_omp_atomic (void) { gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE; - if (gfc_match ("% update") == MATCH_YES) - op = GFC_OMP_ATOMIC_UPDATE; - else if (gfc_match ("% read") == MATCH_YES) - op = GFC_OMP_ATOMIC_READ; - else if (gfc_match ("% write") == MATCH_YES) - op = GFC_OMP_ATOMIC_WRITE; - else if (gfc_match ("% capture") == MATCH_YES) - op = GFC_OMP_ATOMIC_CAPTURE; + int seq_cst = 0; + if (gfc_match ("% seq_cst") == MATCH_YES) + seq_cst = 1; + locus old_loc = gfc_current_locus; + if (seq_cst && gfc_match_char (',') == MATCH_YES) + seq_cst = 2; + if (seq_cst == 2 + || gfc_match_space () == MATCH_YES) + { + gfc_gobble_whitespace (); + if (gfc_match ("update") == MATCH_YES) + op = GFC_OMP_ATOMIC_UPDATE; + else if (gfc_match ("read") == MATCH_YES) + op = GFC_OMP_ATOMIC_READ; + else if (gfc_match ("write") == MATCH_YES) + op = GFC_OMP_ATOMIC_WRITE; + else if (gfc_match ("capture") == MATCH_YES) + op = GFC_OMP_ATOMIC_CAPTURE; + else + { + if (seq_cst == 2) + gfc_current_locus = old_loc; + goto finish; + } + if (!seq_cst + && (gfc_match (", seq_cst") == MATCH_YES + || gfc_match ("% seq_cst") == MATCH_YES)) + seq_cst = 1; + } + finish: if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C"); return MATCH_ERROR; } new_st.op = EXEC_OMP_ATOMIC; + if (seq_cst) + op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); new_st.ext.omp_atomic = op; return MATCH_YES; } @@ -759,6 +1810,73 @@ gfc_match_omp_barrier (void) match +gfc_match_omp_taskgroup (void) +{ + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP TASKGROUP statement at %C"); + return MATCH_ERROR; + } + new_st.op = EXEC_OMP_TASKGROUP; + return MATCH_YES; +} + + +static enum gfc_omp_cancel_kind +gfc_match_omp_cancel_kind (void) +{ + if (gfc_match_space () != MATCH_YES) + return OMP_CANCEL_UNKNOWN; + if (gfc_match ("parallel") == MATCH_YES) + return OMP_CANCEL_PARALLEL; + if (gfc_match ("sections") == MATCH_YES) + return OMP_CANCEL_SECTIONS; + if (gfc_match ("do") == MATCH_YES) + return OMP_CANCEL_DO; + if (gfc_match ("taskgroup") == MATCH_YES) + return OMP_CANCEL_TASKGROUP; + return OMP_CANCEL_UNKNOWN; +} + + +match +gfc_match_omp_cancel (void) +{ + gfc_omp_clauses *c; + enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); + if (kind == OMP_CANCEL_UNKNOWN) + return MATCH_ERROR; + if (gfc_match_omp_clauses (&c, OMP_CLAUSE_IF, false) != MATCH_YES) + return MATCH_ERROR; + c->cancel = kind; + new_st.op = EXEC_OMP_CANCEL; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match +gfc_match_omp_cancellation_point (void) +{ + gfc_omp_clauses *c; + enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind (); + if (kind == OMP_CANCEL_UNKNOWN) + return MATCH_ERROR; + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement " + "at %C"); + return MATCH_ERROR; + } + c = gfc_get_omp_clauses (); + c->cancel = kind; + new_st.op = EXEC_OMP_CANCELLATION_POINT; + new_st.ext.omp_clauses = c; + return MATCH_YES; +} + + +match gfc_match_omp_end_nowait (void) { bool nowait = false; @@ -793,17 +1911,116 @@ gfc_match_omp_end_single (void) } +struct resolve_omp_udr_callback_data +{ + gfc_symbol *sym1, *sym2; +}; + + +static int +resolve_omp_udr_callback (gfc_expr **e, int *, void *data) +{ + struct resolve_omp_udr_callback_data *rcd + = (struct resolve_omp_udr_callback_data *) data; + if ((*e)->expr_type == EXPR_VARIABLE + && ((*e)->symtree->n.sym == rcd->sym1 + || (*e)->symtree->n.sym == rcd->sym2)) + { + gfc_ref *ref = gfc_get_ref (); + ref->type = REF_ARRAY; + ref->u.ar.where = (*e)->where; + ref->u.ar.as = (*e)->symtree->n.sym->as; + ref->u.ar.type = AR_FULL; + ref->u.ar.dimen = 0; + ref->next = (*e)->ref; + (*e)->ref = ref; + } + return 0; +} + + +static int +resolve_omp_udr_callback2 (gfc_expr **e, int *, void *) +{ + if ((*e)->expr_type == EXPR_FUNCTION + && (*e)->value.function.isym == NULL) + { + gfc_symbol *sym = (*e)->symtree->n.sym; + if (!sym->attr.intrinsic + && sym->attr.if_source == IFSRC_UNKNOWN) + gfc_error ("Implicitly declared function %s used in " + "!$OMP DECLARE REDUCTION at %L ", sym->name, &(*e)->where); + } + return 0; +} + + +static gfc_code * +resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns, + gfc_symbol *sym1, gfc_symbol *sym2) +{ + gfc_code *copy; + gfc_symbol sym1_copy, sym2_copy; + + if (ns->code->op == EXEC_ASSIGN) + { + copy = gfc_get_code (EXEC_ASSIGN); + copy->expr1 = gfc_copy_expr (ns->code->expr1); + copy->expr2 = gfc_copy_expr (ns->code->expr2); + } + else + { + copy = gfc_get_code (EXEC_CALL); + copy->symtree = ns->code->symtree; + copy->ext.actual = gfc_copy_actual_arglist (ns->code->ext.actual); + } + copy->loc = ns->code->loc; + sym1_copy = *sym1; + sym2_copy = *sym2; + *sym1 = *n->sym; + *sym2 = *n->sym; + sym1->name = sym1_copy.name; + sym2->name = sym2_copy.name; + ns->proc_name = ns->parent->proc_name; + if (n->sym->attr.dimension) + { + struct resolve_omp_udr_callback_data rcd; + rcd.sym1 = sym1; + rcd.sym2 = sym2; + gfc_code_walker (©, gfc_dummy_code_callback, + resolve_omp_udr_callback, &rcd); + } + gfc_resolve_code (copy, gfc_current_ns); + if (copy->op == EXEC_CALL && copy->resolved_isym == NULL) + { + gfc_symbol *sym = copy->resolved_sym; + if (sym + && !sym->attr.intrinsic + && sym->attr.if_source == IFSRC_UNKNOWN) + gfc_error ("Implicitly declared subroutine %s used in " + "!$OMP DECLARE REDUCTION at %L ", sym->name, + ©->loc); + } + gfc_code_walker (©, gfc_dummy_code_callback, + resolve_omp_udr_callback2, NULL); + *sym1 = sym1_copy; + *sym2 = sym2_copy; + return copy; +} + + /* OpenMP directive resolving routines. */ static void -resolve_omp_clauses (gfc_code *code) +resolve_omp_clauses (gfc_code *code, locus *where, + gfc_omp_clauses *omp_clauses, gfc_namespace *ns) { - gfc_omp_clauses *omp_clauses = code->ext.omp_clauses; - gfc_namelist *n; + gfc_omp_namelist *n; int list; static const char *clause_names[] = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED", - "COPYIN", "REDUCTION" }; + "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP", + "TO", "FROM", "REDUCTION" }; if (omp_clauses == NULL) return; @@ -847,8 +2064,15 @@ resolve_omp_clauses (gfc_code *code) for (n = omp_clauses->lists[list]; n; n = n->next) { n->sym->mark = 0; - if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer) - continue; + if (n->sym->attr.flavor == FL_VARIABLE + || n->sym->attr.proc_pointer + || (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) + { + if (!code && (!n->sym->attr.dummy || n->sym->ns != ns)) + gfc_error ("Variable '%s' is not a dummy argument at %L", + n->sym->name, where); + continue; + } if (n->sym->attr.flavor == FL_PROCEDURE && n->sym->result == n->sym && n->sym->attr.function) @@ -878,16 +2102,22 @@ resolve_omp_clauses (gfc_code *code) } } gfc_error ("Object '%s' is not a variable at %L", n->sym->name, - &code->loc); + where); } for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE) + if (list != OMP_LIST_FIRSTPRIVATE + && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALIGNED + && list != OMP_LIST_DEPEND + && list != OMP_LIST_MAP + && list != OMP_LIST_FROM + && list != OMP_LIST_TO) 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->name, where); else n->sym->mark = 1; } @@ -898,7 +2128,7 @@ resolve_omp_clauses (gfc_code *code) if (n->sym->mark) { gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); n->sym->mark = 0; } @@ -906,7 +2136,7 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); else n->sym->mark = 1; } @@ -917,19 +2147,44 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->mark) gfc_error ("Symbol '%s' present on multiple clauses at %L", - n->sym->name, &code->loc); + n->sym->name, where); + else + n->sym->mark = 1; + } + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + n->sym->mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol '%s' present on multiple clauses at %L", + n->sym->name, where); + else + n->sym->mark = 1; + } + + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + n->sym->mark = 0; + for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) + if (n->expr == NULL) + n->sym->mark = 1; + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + { + if (n->expr == NULL && n->sym->mark) + gfc_error ("Symbol '%s' present on both FROM and TO clauses at %L", + n->sym->name, where); 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) + if (list < OMP_LIST_NUM) name = clause_names[list]; - else if (list <= OMP_LIST_REDUCTION_LAST) - name = clause_names[OMP_LIST_REDUCTION_FIRST]; else gcc_unreachable (); @@ -940,10 +2195,7 @@ resolve_omp_clauses (gfc_code *code) { if (!n->sym->attr.threadprivate) gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause" - " at %L", n->sym->name, &code->loc); - if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components", - n->sym->name, &code->loc); + " at %L", n->sym->name, where); } break; case OMP_LIST_COPYPRIVATE: @@ -951,10 +2203,10 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE) gfc_error ("Assumed size array '%s' in COPYPRIVATE clause " - "at %L", n->sym->name, &code->loc); - if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components", - n->sym->name, &code->loc); + "at %L", n->sym->name, where); + if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN) + gfc_error ("INTENT(IN) POINTER '%s' in COPYPRIVATE clause " + "at %L", n->sym->name, where); } break; case OMP_LIST_SHARED: @@ -962,96 +2214,286 @@ resolve_omp_clauses (gfc_code *code) { if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object '%s' in SHARED clause at " - "%L", n->sym->name, &code->loc); + "%L", n->sym->name, where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee '%s' in SHARED clause at %L", - n->sym->name, &code->loc); + n->sym->name, where); + if (n->sym->attr.associate_var) + gfc_error ("ASSOCIATE name '%s' in SHARED clause at %L", + n->sym->name, where); + } + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.pointer + && !n->sym->attr.allocatable + && !n->sym->attr.cray_pointer + && (n->sym->ts.type != BT_DERIVED + || (n->sym->ts.u.derived->from_intmod + != INTMOD_ISO_C_BINDING) + || (n->sym->ts.u.derived->intmod_sym_id + != ISOCBINDING_PTR))) + gfc_error ("'%s' in ALIGNED clause must be POINTER, " + "ALLOCATABLE, Cray pointer or C_PTR at %L", + n->sym->name, where); + else if (n->expr) + { + gfc_expr *expr = n->expr; + int alignment = 0; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0 + || gfc_extract_int (expr, &alignment) + || alignment <= 0) + gfc_error ("'%s' in ALIGNED clause at %L requires a scalar " + "positive constant integer alignment " + "expression", n->sym->name, where); + } } break; + case OMP_LIST_DEPEND: + case OMP_LIST_MAP: + case OMP_LIST_TO: + case OMP_LIST_FROM: + for (; n != NULL; n = n->next) + if (n->expr) + { + if (!gfc_resolve_expr (n->expr) + || n->expr->expr_type != EXPR_VARIABLE + || n->expr->ref == NULL + || n->expr->ref->next + || n->expr->ref->type != REF_ARRAY) + gfc_error ("'%s' in %s clause at %L is not a proper " + "array section", n->sym->name, name, where); + else if (n->expr->ref->u.ar.codimen) + gfc_error ("Coarrays not supported in %s clause at %L", + name, where); + else + { + int i; + gfc_array_ref *ar = &n->expr->ref->u.ar; + for (i = 0; i < ar->dimen; i++) + if (ar->stride[i]) + { + gfc_error ("Stride should not be specified for " + "array section in %s clause at %L", + name, where); + break; + } + else if (ar->dimen_type[i] != DIMEN_ELEMENT + && ar->dimen_type[i] != DIMEN_RANGE) + { + gfc_error ("'%s' in %s clause at %L is not a " + "proper array section", + n->sym->name, name, where); + break; + } + else if (list == OMP_LIST_DEPEND + && ar->start[i] + && ar->start[i]->expr_type == EXPR_CONSTANT + && ar->end[i] + && ar->end[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (ar->start[i]->value.integer, + ar->end[i]->value.integer) > 0) + { + gfc_error ("'%s' in DEPEND clause at %L is a zero " + "size array section", n->sym->name, + where); + break; + } + } + } + if (list != OMP_LIST_DEPEND) + for (n = omp_clauses->lists[list]; n != NULL; n = n->next) + { + n->sym->attr.referenced = 1; + if (n->sym->attr.threadprivate) + gfc_error ("THREADPRIVATE object '%s' in %s clause at %L", + n->sym->name, name, where); + if (n->sym->attr.cray_pointee) + gfc_error ("Cray pointee '%s' in %s clause at %L", + n->sym->name, name, where); + } + break; default: for (; n != NULL; n = n->next) { + bool bad = false; if (n->sym->attr.threadprivate) gfc_error ("THREADPRIVATE object '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); if (n->sym->attr.cray_pointee) gfc_error ("Cray pointee '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); + if (n->sym->attr.associate_var) + gfc_error ("ASSOCIATE name '%s' in %s clause at %L", + n->sym->name, name, where); if (list != OMP_LIST_PRIVATE) { - if (n->sym->attr.pointer - && list >= OMP_LIST_REDUCTION_FIRST - && list <= OMP_LIST_REDUCTION_LAST) + if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION) + gfc_error ("Procedure pointer '%s' in %s clause at %L", + n->sym->name, name, where); + if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION) gfc_error ("POINTER object '%s' in %s clause at %L", - n->sym->name, name, &code->loc); - /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below). */ - if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) - && n->sym->ts.type == BT_DERIVED - && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L", - name, n->sym->name, &code->loc); - if (n->sym->attr.cray_pointer - && list >= OMP_LIST_REDUCTION_FIRST - && list <= OMP_LIST_REDUCTION_LAST) + n->sym->name, name, where); + if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION) gfc_error ("Cray pointer '%s' in %s clause at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); } 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)) + n->sym->name, name, where); + if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION) gfc_error ("Variable '%s' in %s clause is used in " "NAMELIST statement at %L", - n->sym->name, name, &code->loc); + n->sym->name, name, where); + if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN) + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_LINEAR: + /* case OMP_LIST_REDUCTION: */ + gfc_error ("INTENT(IN) POINTER '%s' in %s clause at %L", + n->sym->name, name, where); + break; + default: + break; + } switch (list) { - case OMP_LIST_PLUS: - case OMP_LIST_MULT: - case OMP_LIST_SUB: - if (!gfc_numeric_ts (&n->sym->ts)) - gfc_error ("%c REDUCTION variable '%s' at %L must be of numeric type, got %s", - list == OMP_LIST_PLUS ? '+' - : list == OMP_LIST_MULT ? '*' : '-', - n->sym->name, &code->loc, - gfc_typename (&n->sym->ts)); - break; - case OMP_LIST_AND: - case OMP_LIST_OR: - case OMP_LIST_EQV: - case OMP_LIST_NEQV: - if (n->sym->ts.type != BT_LOGICAL) - gfc_error ("%s REDUCTION variable '%s' must be LOGICAL " - "at %L", - list == OMP_LIST_AND ? ".AND." - : list == OMP_LIST_OR ? ".OR." - : list == OMP_LIST_EQV ? ".EQV." : ".NEQV.", - n->sym->name, &code->loc); - break; - case OMP_LIST_MAX: - case OMP_LIST_MIN: - if (n->sym->ts.type != BT_INTEGER - && n->sym->ts.type != BT_REAL) - gfc_error ("%s REDUCTION variable '%s' must be " - "INTEGER or REAL at %L", - list == OMP_LIST_MAX ? "MAX" : "MIN", - n->sym->name, &code->loc); + case OMP_LIST_REDUCTION: + switch (n->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + if (!gfc_numeric_ts (&n->sym->ts)) + bad = true; + break; + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + if (n->sym->ts.type != BT_LOGICAL) + bad = true; + break; + case OMP_REDUCTION_MAX: + case OMP_REDUCTION_MIN: + if (n->sym->ts.type != BT_INTEGER + && n->sym->ts.type != BT_REAL) + bad = true; + break; + case OMP_REDUCTION_IAND: + case OMP_REDUCTION_IOR: + case OMP_REDUCTION_IEOR: + if (n->sym->ts.type != BT_INTEGER) + bad = true; + break; + case OMP_REDUCTION_USER: + bad = true; + break; + default: + break; + } + if (!bad) + n->udr = NULL; + else + { + const char *udr_name = NULL; + if (n->udr) + { + udr_name = n->udr->udr->name; + n->udr->udr + = gfc_find_omp_udr (NULL, udr_name, + &n->sym->ts); + if (n->udr->udr == NULL) + { + free (n->udr); + n->udr = NULL; + } + } + if (n->udr == NULL) + { + if (udr_name == NULL) + switch (n->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + udr_name = gfc_op2string ((gfc_intrinsic_op) + n->u.reduction_op); + break; + case OMP_REDUCTION_MAX: + udr_name = "max"; + break; + case OMP_REDUCTION_MIN: + udr_name = "min"; + break; + case OMP_REDUCTION_IAND: + udr_name = "iand"; + break; + case OMP_REDUCTION_IOR: + udr_name = "ior"; + break; + case OMP_REDUCTION_IEOR: + udr_name = "ieor"; + break; + default: + gcc_unreachable (); + } + gfc_error ("!$OMP DECLARE REDUCTION %s not found " + "for type %s at %L", udr_name, + gfc_typename (&n->sym->ts), where); + } + else + { + gfc_omp_udr *udr = n->udr->udr; + n->u.reduction_op = OMP_REDUCTION_USER; + n->udr->combiner + = resolve_omp_udr_clause (n, udr->combiner_ns, + udr->omp_out, + udr->omp_in); + if (udr->initializer_ns) + n->udr->initializer + = resolve_omp_udr_clause (n, + udr->initializer_ns, + udr->omp_priv, + udr->omp_orig); + } + } break; - case OMP_LIST_IAND: - case OMP_LIST_IOR: - case OMP_LIST_IEOR: + case OMP_LIST_LINEAR: 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); + gfc_error ("LINEAR variable '%s' must be INTEGER " + "at %L", n->sym->name, where); + else if (!code && !n->sym->attr.value) + gfc_error ("LINEAR dummy argument '%s' must have VALUE " + "attribute at %L", n->sym->name, where); + else if (n->expr) + { + gfc_expr *expr = n->expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER + || expr->rank != 0) + gfc_error ("'%s' in LINEAR clause at %L requires " + "a scalar integer linear-step expression", + n->sym->name, where); + else if (!code && expr->expr_type != EXPR_CONSTANT) + gfc_error ("'%s' in LINEAR clause at %L requires " + "a constant integer linear-step expression", + n->sym->name, where); + } break; /* Workaround for PR middle-end/26316, nothing really needs to be done here for OMP_LIST_PRIVATE. */ case OMP_LIST_PRIVATE: - gcc_assert (code->op != EXEC_NOP); + gcc_assert (code && code->op != EXEC_NOP); default: break; } @@ -1059,6 +2501,54 @@ resolve_omp_clauses (gfc_code *code) break; } } + if (omp_clauses->safelen_expr) + { + gfc_expr *expr = omp_clauses->safelen_expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("SAFELEN clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->simdlen_expr) + { + gfc_expr *expr = omp_clauses->simdlen_expr; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("SIMDLEN clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->num_teams) + { + gfc_expr *expr = omp_clauses->num_teams; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("NUM_TEAMS clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->device) + { + gfc_expr *expr = omp_clauses->device; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("DEVICE clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } + if (omp_clauses->dist_chunk_size) + { + gfc_expr *expr = omp_clauses->dist_chunk_size; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("DIST_SCHEDULE clause's chunk_size at %L requires " + "a scalar INTEGER expression", &expr->where); + } + if (omp_clauses->thread_limit) + { + gfc_expr *expr = omp_clauses->thread_limit; + if (!gfc_resolve_expr (expr) + || expr->ts.type != BT_INTEGER || expr->rank != 0) + gfc_error ("THREAD_LIMIT clause at %L requires a scalar " + "INTEGER expression", &expr->where); + } } @@ -1142,12 +2632,13 @@ resolve_omp_atomic (gfc_code *code) gfc_code *atomic_code = code; gfc_symbol *var; gfc_expr *expr2, *expr2_tmp; + gfc_omp_atomic_op aop + = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); - gcc_assert ((atomic_code->ext.omp_atomic != GFC_OMP_ATOMIC_CAPTURE - && code->next == NULL) - || (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE + gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) && code->next == NULL) + || ((aop == GFC_OMP_ATOMIC_CAPTURE) && code->next != NULL && code->next->op == EXEC_ASSIGN && code->next->next == NULL)); @@ -1169,14 +2660,13 @@ resolve_omp_atomic (gfc_code *code) expr2 = is_conversion (code->expr2, false); if (expr2 == NULL) { - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_READ - || atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (aop == GFC_OMP_ATOMIC_READ || aop == GFC_OMP_ATOMIC_WRITE) expr2 = is_conversion (code->expr2, true); if (expr2 == NULL) expr2 = code->expr2; } - switch (atomic_code->ext.omp_atomic) + switch (aop) { case GFC_OMP_ATOMIC_READ: if (expr2->expr_type != EXPR_VARIABLE @@ -1249,7 +2739,21 @@ resolve_omp_atomic (gfc_code *code) break; } - if (expr2->expr_type == EXPR_OP) + if (var->attr.allocatable) + { + gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L", + &code->loc); + return; + } + + if (aop == GFC_OMP_ATOMIC_CAPTURE + && code->next == NULL + && code->expr2->rank == 0 + && !expr_references_sym (code->expr2, var, NULL)) + atomic_code->ext.omp_atomic + = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic + | GFC_OMP_ATOMIC_SWAP); + else if (expr2->expr_type == EXPR_OP) { gfc_expr *v = NULL, *e, *c; gfc_intrinsic_op op = expr2->value.op.op; @@ -1420,11 +2924,18 @@ resolve_omp_atomic (gfc_code *code) && 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); + { + gfc_error ("!$OMP ATOMIC intrinsic arguments except one must " + "not reference '%s' at %L", + var->name, &arg->expr->where); + return; + } if (arg->expr->rank != 0) - gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar " - "at %L", &arg->expr->where); + { + gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar " + "at %L", &arg->expr->where); + return; + } } if (var_arg == NULL) @@ -1447,10 +2958,10 @@ resolve_omp_atomic (gfc_code *code) } } else - gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic " - "on right hand side at %L", &expr2->where); + gfc_error ("!$OMP ATOMIC assignment must have an operator or " + "intrinsic on right hand side at %L", &expr2->where); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE && code->next) + if (aop == GFC_OMP_ATOMIC_CAPTURE && code->next) { code = code->next; if (code->expr1->expr_type != EXPR_VARIABLE @@ -1542,7 +3053,7 @@ 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; + gfc_omp_namelist *n; int list; ctx.code = code; @@ -1552,13 +3063,38 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) 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); + switch (list) + { + case OMP_LIST_SHARED: + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_LINEAR: + for (n = omp_clauses->lists[list]; n; n = n->next) + pointer_set_insert (ctx.sharing_clauses, n->sym); + break; + default: + break; + } - if (code->op == EXEC_OMP_PARALLEL_DO) - gfc_resolve_omp_do_blocks (code, ns); - else - gfc_resolve_blocks (code->block, ns); + switch (code->op) + { + case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + gfc_resolve_omp_do_blocks (code, ns); + break; + default: + gfc_resolve_blocks (code->block, ns); + } omp_current_ctx = ctx.previous; pointer_set_destroy (ctx.sharing_clauses); @@ -1624,9 +3160,9 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym) if (! pointer_set_insert (omp_current_ctx->private_iterators, sym)) { gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses; - gfc_namelist *p; + gfc_omp_namelist *p; - p = gfc_get_namelist (); + p = gfc_get_omp_namelist (); p->sym = sym; p->next = omp_clauses->lists[OMP_LIST_PRIVATE]; omp_clauses->lists[OMP_LIST_PRIVATE] = p; @@ -1639,11 +3175,64 @@ resolve_omp_do (gfc_code *code) { gfc_code *do_code, *c; int list, i, collapse; - gfc_namelist *n; + gfc_omp_namelist *n; gfc_symbol *dovar; + const char *name; + bool is_simd = false; + + switch (code->op) + { + case EXEC_OMP_DISTRIBUTE: name = "!$OMP DISTRIBUTE"; break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + name = "!$OMP DISTRIBUTE PARALLEL DO"; + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "!$OMP DISTRIBUTE PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_DISTRIBUTE_SIMD: + name = "!$OMP DISTRIBUTE SIMD"; + is_simd = true; + break; + case EXEC_OMP_DO: name = "!$OMP DO"; break; + case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break; + case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break; + case EXEC_OMP_PARALLEL_DO_SIMD: + name = "!$OMP PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + name = "!$OMP TARGET TEAMS_DISTRIBUTE"; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: name = "!$OMP TEAMS_DISTRIBUTE"; break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + name = "!$OMP TEAMS DISTRIBUTE PARALLEL DO SIMD"; + is_simd = true; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + name = "!$OMP TEAMS DISTRIBUTE SIMD"; + is_simd = true; + break; + default: gcc_unreachable (); + } if (code->ext.omp_clauses) - resolve_omp_clauses (code); + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); do_code = code->block->next; collapse = code->ext.omp_clauses->collapse; @@ -1653,27 +3242,46 @@ resolve_omp_do (gfc_code *code) { 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); + gfc_error ("%s cannot be a DO WHILE or DO without loop control " + "at %L", name, &do_code->loc); + break; + } + if (do_code->op == EXEC_DO_CONCURRENT) + { + gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name, + &do_code->loc); break; } gcc_assert (do_code->op == EXEC_DO); if (do_code->ext.iterator->var->ts.type != BT_INTEGER) - gfc_error ("!$OMP DO iteration variable must be of type integer at %L", - &do_code->loc); + gfc_error ("%s iteration variable must be of type integer at %L", + name, &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); + gfc_error ("%s iteration variable must not be THREADPRIVATE " + "at %L", name, &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) + if (!is_simd + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + : code->ext.omp_clauses->collapse > 1 + ? (list != OMP_LIST_LASTPRIVATE) + : (list != OMP_LIST_LINEAR)) 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); + if (!is_simd) + gfc_error ("%s iteration variable present on clause " + "other than PRIVATE or LASTPRIVATE at %L", + name, &do_code->loc); + else if (code->ext.omp_clauses->collapse > 1) + gfc_error ("%s iteration variable present on clause " + "other than LASTPRIVATE at %L", + name, &do_code->loc); + else + gfc_error ("%s iteration variable present on clause " + "other than LINEAR at %L", + name, &do_code->loc); break; } if (i > 1) @@ -1689,8 +3297,8 @@ resolve_omp_do (gfc_code *code) || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end) || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step)) { - gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L", - &do_code->loc); + gfc_error ("%s collapsed loops don't form rectangular " + "iteration space at %L", name, &do_code->loc); break; } if (j < i) @@ -1703,8 +3311,8 @@ resolve_omp_do (gfc_code *code) for (c = do_code->next; c; c = c->next) if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE) { - gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L", - &c->loc); + gfc_error ("collapsed %s loops not perfectly nested at %L", + name, &c->loc); break; } if (c) @@ -1712,16 +3320,16 @@ resolve_omp_do (gfc_code *code) do_code = do_code->block; if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE) { - gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", - &code->loc); + gfc_error ("not enough DO loops for collapsed %s at %L", + name, &code->loc); break; } do_code = do_code->next; if (do_code == NULL || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)) { - gfc_error ("not enough DO loops for collapsed !$OMP DO at %L", - &code->loc); + gfc_error ("not enough DO loops for collapsed %s at %L", + name, &code->loc); break; } } @@ -1739,19 +3347,48 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) switch (code->op) { + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: resolve_omp_do (code); break; - case EXEC_OMP_WORKSHARE: + case EXEC_OMP_CANCEL: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_WORKSHARE: if (code->ext.omp_clauses) - resolve_omp_clauses (code); + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + break; + case EXEC_OMP_TARGET_UPDATE: + if (code->ext.omp_clauses) + resolve_omp_clauses (code, &code->loc, code->ext.omp_clauses, NULL); + if (code->ext.omp_clauses == NULL + || (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL + && code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL)) + gfc_error ("OMP TARGET UPDATE at %L requires at least one TO or " + "FROM clause", &code->loc); break; case EXEC_OMP_ATOMIC: resolve_omp_atomic (code); @@ -1760,3 +3397,165 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) break; } } + +/* Resolve !$omp declare simd constructs in NS. */ + +void +gfc_resolve_omp_declare_simd (gfc_namespace *ns) +{ + gfc_omp_declare_simd *ods; + + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + if (ods->proc_name != ns->proc_name) + gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure " + "'%s' at %L", ns->proc_name->name, &ods->where); + if (ods->clauses) + resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns); + } +} + +struct omp_udr_callback_data +{ + gfc_omp_udr *omp_udr; + bool is_initializer; +}; + +static int +omp_udr_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data) +{ + struct omp_udr_callback_data *cd = (struct omp_udr_callback_data *) data; + if ((*e)->expr_type == EXPR_VARIABLE) + { + if (cd->is_initializer) + { + if ((*e)->symtree->n.sym != cd->omp_udr->omp_priv + && (*e)->symtree->n.sym != cd->omp_udr->omp_orig) + gfc_error ("Variable other than OMP_PRIV or OMP_ORIG used in " + "INITIALIZER clause of !$OMP DECLARE REDUCTION at %L", + &(*e)->where); + } + else + { + if ((*e)->symtree->n.sym != cd->omp_udr->omp_out + && (*e)->symtree->n.sym != cd->omp_udr->omp_in) + gfc_error ("Variable other than OMP_OUT or OMP_IN used in " + "combiner of !$OMP DECLARE REDUCTION at %L", + &(*e)->where); + } + } + return 0; +} + +/* Resolve !$omp declare reduction constructs. */ + +static void +gfc_resolve_omp_udr (gfc_omp_udr *omp_udr) +{ + gfc_actual_arglist *a; + const char *predef_name = NULL; + + switch (omp_udr->rop) + { + case OMP_REDUCTION_PLUS: + case OMP_REDUCTION_TIMES: + case OMP_REDUCTION_MINUS: + case OMP_REDUCTION_AND: + case OMP_REDUCTION_OR: + case OMP_REDUCTION_EQV: + case OMP_REDUCTION_NEQV: + case OMP_REDUCTION_MAX: + case OMP_REDUCTION_USER: + break; + default: + gfc_error ("Invalid operator for !$OMP DECLARE REDUCTION %s at %L", + omp_udr->name, &omp_udr->where); + return; + } + + if (gfc_omp_udr_predef (omp_udr->rop, omp_udr->name, + &omp_udr->ts, &predef_name)) + { + if (predef_name) + gfc_error_now ("Redefinition of predefined %s " + "!$OMP DECLARE REDUCTION at %L", + predef_name, &omp_udr->where); + else + gfc_error_now ("Redefinition of predefined " + "!$OMP DECLARE REDUCTION at %L", &omp_udr->where); + return; + } + + if (omp_udr->ts.type == BT_CHARACTER + && omp_udr->ts.u.cl->length + && omp_udr->ts.u.cl->length->expr_type != EXPR_CONSTANT) + { + gfc_error ("CHARACTER length in !$OMP DECLARE REDUCTION %s not " + "constant at %L", omp_udr->name, &omp_udr->where); + return; + } + + struct omp_udr_callback_data cd; + cd.omp_udr = omp_udr; + cd.is_initializer = false; + gfc_code_walker (&omp_udr->combiner_ns->code, gfc_dummy_code_callback, + omp_udr_callback, &cd); + if (omp_udr->combiner_ns->code->op == EXEC_CALL) + { + for (a = omp_udr->combiner_ns->code->ext.actual; a; a = a->next) + if (a->expr == NULL) + break; + if (a) + gfc_error ("Subroutine call with alternate returns in combiner " + "of !$OMP DECLARE REDUCTION at %L", + &omp_udr->combiner_ns->code->loc); + } + if (omp_udr->initializer_ns) + { + cd.is_initializer = true; + gfc_code_walker (&omp_udr->initializer_ns->code, gfc_dummy_code_callback, + omp_udr_callback, &cd); + if (omp_udr->initializer_ns->code->op == EXEC_CALL) + { + for (a = omp_udr->initializer_ns->code->ext.actual; a; a = a->next) + if (a->expr == NULL) + break; + if (a) + gfc_error ("Subroutine call with alternate returns in " + "INITIALIZER clause of !$OMP DECLARE REDUCTION " + "at %L", &omp_udr->initializer_ns->code->loc); + for (a = omp_udr->initializer_ns->code->ext.actual; a; a = a->next) + if (a->expr + && a->expr->expr_type == EXPR_VARIABLE + && a->expr->symtree->n.sym == omp_udr->omp_priv + && a->expr->ref == NULL) + break; + if (a == NULL) + gfc_error ("One of actual subroutine arguments in INITIALIZER " + "clause of !$OMP DECLARE REDUCTION must be OMP_PRIV " + "at %L", &omp_udr->initializer_ns->code->loc); + } + } + else if (omp_udr->ts.type == BT_DERIVED + && !gfc_has_default_initializer (omp_udr->ts.u.derived)) + { + gfc_error ("Missing INITIALIZER clause for !$OMP DECLARE REDUCTION " + "of derived type without default initializer at %L", + &omp_udr->where); + return; + } +} + +void +gfc_resolve_omp_udrs (gfc_symtree *st) +{ + gfc_omp_udr *omp_udr; + + if (st == NULL) + return; + gfc_resolve_omp_udrs (st->left); + gfc_resolve_omp_udrs (st->right); + for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next) + gfc_resolve_omp_udr (omp_udr); +} diff --git a/gcc-4.9/gcc/fortran/parse.c b/gcc-4.9/gcc/fortran/parse.c index 0faf47a00..3428b331e 100644 --- a/gcc-4.9/gcc/fortran/parse.c +++ b/gcc-4.9/gcc/fortran/parse.c @@ -74,6 +74,34 @@ match_word (const char *str, match (*subr) (void), locus *old_locus) } +/* Like match_word, but if str is matched, set a flag that it + was matched. */ +static match +match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus, + bool *simd_matched) +{ + match m; + + if (str != NULL) + { + m = gfc_match (str); + if (m != MATCH_YES) + return m; + *simd_matched = true; + } + + m = (*subr) (); + + if (m != MATCH_YES) + { + gfc_current_locus = *old_locus; + reject_statement (); + } + + return m; +} + + /* Load symbols from all USE statements encountered in this scoping unit. */ static void @@ -103,7 +131,7 @@ use_modules (void) if (match_word (keyword, subr, &old_locus) == MATCH_YES) \ return st; \ else \ - undo_new_statement (); \ + undo_new_statement (); \ } while (0); @@ -531,11 +559,34 @@ decode_statement (void) return ST_NONE; } +/* Like match, but set a flag simd_matched if keyword matched. */ +#define matchs(keyword, subr, st) \ + do { \ + if (match_word_omp_simd (keyword, subr, &old_locus, \ + &simd_matched) == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + +/* Like match, but don't match anything if not -fopenmp. */ +#define matcho(keyword, subr, st) \ + do { \ + if (!gfc_option.gfc_flag_openmp) \ + ; \ + else if (match_word (keyword, subr, &old_locus) \ + == MATCH_YES) \ + return st; \ + else \ + undo_new_statement (); \ + } while (0); + static gfc_statement decode_omp_directive (void) { locus old_locus; char c; + bool simd_matched = false; gfc_enforce_clean_symbol_state (); @@ -560,77 +611,167 @@ decode_omp_directive (void) c = gfc_peek_ascii_char (); + /* match is for directives that should be recognized only if + -fopenmp, matchs for directives that should be recognized + if either -fopenmp or -fopenmp-simd. */ switch (c) { case 'a': - match ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); + matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); break; case 'b': - match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); + matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); break; case 'c': - match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); + matcho ("cancellation% point", gfc_match_omp_cancellation_point, + ST_OMP_CANCELLATION_POINT); + matcho ("cancel", gfc_match_omp_cancel, ST_OMP_CANCEL); + matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL); break; case 'd': - match ("do", gfc_match_omp_do, ST_OMP_DO); + matchs ("declare reduction", gfc_match_omp_declare_reduction, + ST_OMP_DECLARE_REDUCTION); + matchs ("declare simd", gfc_match_omp_declare_simd, + ST_OMP_DECLARE_SIMD); + matcho ("declare target", gfc_match_omp_declare_target, + ST_OMP_DECLARE_TARGET); + matchs ("distribute parallel do simd", + gfc_match_omp_distribute_parallel_do_simd, + ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("distribute parallel do", gfc_match_omp_distribute_parallel_do, + ST_OMP_DISTRIBUTE_PARALLEL_DO); + matchs ("distribute simd", gfc_match_omp_distribute_simd, + ST_OMP_DISTRIBUTE_SIMD); + matcho ("distribute", gfc_match_omp_distribute, ST_OMP_DISTRIBUTE); + matchs ("do simd", gfc_match_omp_do_simd, ST_OMP_DO_SIMD); + matcho ("do", gfc_match_omp_do, ST_OMP_DO); break; case 'e': - match ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); - match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); - match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); - match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER); - match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED); - match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO); - match ("end parallel sections", gfc_match_omp_eos, - ST_OMP_END_PARALLEL_SECTIONS); - match ("end parallel workshare", gfc_match_omp_eos, - ST_OMP_END_PARALLEL_WORKSHARE); - match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); - match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); - match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); - match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); - match ("end workshare", gfc_match_omp_end_nowait, - ST_OMP_END_WORKSHARE); + matcho ("end atomic", gfc_match_omp_eos, ST_OMP_END_ATOMIC); + matcho ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL); + matchs ("end distribute parallel do simd", gfc_match_omp_eos, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("end distribute parallel do", gfc_match_omp_eos, + ST_OMP_END_DISTRIBUTE_PARALLEL_DO); + matchs ("end distribute simd", gfc_match_omp_eos, + ST_OMP_END_DISTRIBUTE_SIMD); + matcho ("end distribute", gfc_match_omp_eos, ST_OMP_END_DISTRIBUTE); + matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); + matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); + matchs ("end simd", gfc_match_omp_eos, ST_OMP_END_SIMD); + matcho ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER); + matcho ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED); + matchs ("end parallel do simd", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_DO_SIMD); + matcho ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO); + matcho ("end parallel sections", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_SECTIONS); + matcho ("end parallel workshare", gfc_match_omp_eos, + ST_OMP_END_PARALLEL_WORKSHARE); + matcho ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL); + matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); + matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); + matcho ("end target data", gfc_match_omp_eos, ST_OMP_END_TARGET_DATA); + matchs ("end target teams distribute parallel do simd", + gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("end target teams distribute parallel do", gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("end target teams distribute simd", gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD); + matcho ("end target teams distribute", gfc_match_omp_eos, + ST_OMP_END_TARGET_TEAMS_DISTRIBUTE); + matcho ("end target teams", gfc_match_omp_eos, ST_OMP_END_TARGET_TEAMS); + matcho ("end target", gfc_match_omp_eos, ST_OMP_END_TARGET); + matcho ("end taskgroup", gfc_match_omp_eos, ST_OMP_END_TASKGROUP); + matcho ("end task", gfc_match_omp_eos, ST_OMP_END_TASK); + matchs ("end teams distribute parallel do simd", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("end teams distribute parallel do", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("end teams distribute simd", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE_SIMD); + matcho ("end teams distribute", gfc_match_omp_eos, + ST_OMP_END_TEAMS_DISTRIBUTE); + matcho ("end teams", gfc_match_omp_eos, ST_OMP_END_TEAMS); + matcho ("end workshare", gfc_match_omp_end_nowait, + ST_OMP_END_WORKSHARE); break; case 'f': - match ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); + matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); break; case 'm': - match ("master", gfc_match_omp_master, ST_OMP_MASTER); + matcho ("master", gfc_match_omp_master, ST_OMP_MASTER); break; case 'o': - match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED); + matcho ("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); + matchs ("parallel do simd", gfc_match_omp_parallel_do_simd, + ST_OMP_PARALLEL_DO_SIMD); + matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO); + matcho ("parallel sections", gfc_match_omp_parallel_sections, + ST_OMP_PARALLEL_SECTIONS); + matcho ("parallel workshare", gfc_match_omp_parallel_workshare, + ST_OMP_PARALLEL_WORKSHARE); + matcho ("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); + matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS); + matcho ("section", gfc_match_omp_eos, ST_OMP_SECTION); + matchs ("simd", gfc_match_omp_simd, ST_OMP_SIMD); + matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE); break; case 't': - match ("task", gfc_match_omp_task, ST_OMP_TASK); - match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); - match ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); - match ("threadprivate", gfc_match_omp_threadprivate, - ST_OMP_THREADPRIVATE); + matcho ("target data", gfc_match_omp_target_data, ST_OMP_TARGET_DATA); + matchs ("target teams distribute parallel do simd", + gfc_match_omp_target_teams_distribute_parallel_do_simd, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("target teams distribute parallel do", + gfc_match_omp_target_teams_distribute_parallel_do, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("target teams distribute simd", + gfc_match_omp_target_teams_distribute_simd, + ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD); + matcho ("target teams distribute", gfc_match_omp_target_teams_distribute, + ST_OMP_TARGET_TEAMS_DISTRIBUTE); + matcho ("target teams", gfc_match_omp_target_teams, ST_OMP_TARGET_TEAMS); + matcho ("target update", gfc_match_omp_target_update, + ST_OMP_TARGET_UPDATE); + matcho ("target", gfc_match_omp_target, ST_OMP_TARGET); + matcho ("taskgroup", gfc_match_omp_taskgroup, ST_OMP_TASKGROUP); + matcho ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT); + matcho ("taskyield", gfc_match_omp_taskyield, ST_OMP_TASKYIELD); + matcho ("task", gfc_match_omp_task, ST_OMP_TASK); + matchs ("teams distribute parallel do simd", + gfc_match_omp_teams_distribute_parallel_do_simd, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); + matcho ("teams distribute parallel do", + gfc_match_omp_teams_distribute_parallel_do, + ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO); + matchs ("teams distribute simd", gfc_match_omp_teams_distribute_simd, + ST_OMP_TEAMS_DISTRIBUTE_SIMD); + matcho ("teams distribute", gfc_match_omp_teams_distribute, + ST_OMP_TEAMS_DISTRIBUTE); + matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS); + matcho ("threadprivate", gfc_match_omp_threadprivate, + ST_OMP_THREADPRIVATE); break; case 'w': - match ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE); + matcho ("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. */ + stored an error message of some sort. Don't error out if + not -fopenmp and simd_matched is false, i.e. if a directive other + than one marked with match has been seen. */ - if (gfc_error_check () == 0) - gfc_error_now ("Unclassifiable OpenMP directive at %C"); + if (gfc_option.gfc_flag_openmp || simd_matched) + { + if (gfc_error_check () == 0) + gfc_error_now ("Unclassifiable OpenMP directive at %C"); + } reject_statement (); @@ -753,7 +894,9 @@ next_free (void) return decode_gcc_attribute (); } - else if (c == '$' && gfc_option.gfc_flag_openmp) + else if (c == '$' + && (gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd)) { int i; @@ -842,7 +985,9 @@ next_fixed (void) return decode_gcc_attribute (); } - else if (c == '$' && gfc_option.gfc_flag_openmp) + else if (c == '$' + && (gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd)) { for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING)) gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]); @@ -1013,8 +1158,9 @@ next_statement (void) case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \ - case ST_ERROR_STOP: case ST_SYNC_ALL: case ST_SYNC_IMAGES: \ - case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK + case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ + case ST_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \ + case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK /* Statements that mark other executable statements. */ @@ -1026,14 +1172,28 @@ next_statement (void) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \ - case ST_OMP_TASK: case ST_CRITICAL + case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \ + case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO_SIMD: case ST_OMP_TARGET: \ + case ST_OMP_TARGET_DATA: case ST_OMP_TARGET_TEAMS: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: \ + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \ + case ST_OMP_TEAMS: case ST_OMP_TEAMS_DISTRIBUTE: \ + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: \ + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \ + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE: \ + case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DISTRIBUTE_PARALLEL_DO: \ + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: \ + case ST_CRITICAL /* Declaration statements */ #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \ case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \ - case ST_PROCEDURE + case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \ + case ST_OMP_DECLARE_TARGET /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -1524,21 +1684,69 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_BARRIER: p = "!$OMP BARRIER"; break; + case ST_OMP_CANCEL: + p = "!$OMP CANCEL"; + break; + case ST_OMP_CANCELLATION_POINT: + p = "!$OMP CANCELLATION POINT"; + break; case ST_OMP_CRITICAL: p = "!$OMP CRITICAL"; break; + case ST_OMP_DECLARE_REDUCTION: + p = "!$OMP DECLARE REDUCTION"; + break; + case ST_OMP_DECLARE_SIMD: + p = "!$OMP DECLARE SIMD"; + break; + case ST_OMP_DECLARE_TARGET: + p = "!$OMP DECLARE TARGET"; + break; + case ST_OMP_DISTRIBUTE: + p = "!$OMP DISTRIBUTE"; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_DISTRIBUTE_SIMD: + p = "!$OMP DISTRIBUTE SIMD"; + break; case ST_OMP_DO: p = "!$OMP DO"; break; + case ST_OMP_DO_SIMD: + p = "!$OMP DO SIMD"; + break; case ST_OMP_END_ATOMIC: p = "!$OMP END ATOMIC"; break; case ST_OMP_END_CRITICAL: p = "!$OMP END CRITICAL"; break; + case ST_OMP_END_DISTRIBUTE: + p = "!$OMP END DISTRIBUTE"; + break; + case ST_OMP_END_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP END DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP END DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_END_DISTRIBUTE_SIMD: + p = "!$OMP END DISTRIBUTE SIMD"; + break; case ST_OMP_END_DO: p = "!$OMP END DO"; break; + case ST_OMP_END_DO_SIMD: + p = "!$OMP END DO SIMD"; + break; + case ST_OMP_END_SIMD: + p = "!$OMP END SIMD"; + break; case ST_OMP_END_MASTER: p = "!$OMP END MASTER"; break; @@ -1551,6 +1759,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_PARALLEL_DO: p = "!$OMP END PARALLEL DO"; break; + case ST_OMP_END_PARALLEL_DO_SIMD: + p = "!$OMP END PARALLEL DO SIMD"; + break; case ST_OMP_END_PARALLEL_SECTIONS: p = "!$OMP END PARALLEL SECTIONS"; break; @@ -1566,6 +1777,45 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_END_TASK: p = "!$OMP END TASK"; break; + case ST_OMP_END_TARGET: + p = "!$OMP END TARGET"; + break; + case ST_OMP_END_TARGET_DATA: + p = "!$OMP END TARGET DATA"; + break; + case ST_OMP_END_TARGET_TEAMS: + p = "!$OMP END TARGET TEAMS"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE: + p = "!$OMP END TARGET TEAMS DISTRIBUTE"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP END TARGET TEAMS DISTRIBUTE SIMD"; + break; + case ST_OMP_END_TASKGROUP: + p = "!$OMP END TASKGROUP"; + break; + case ST_OMP_END_TEAMS: + p = "!$OMP END TEAMS"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE: + p = "!$OMP END TEAMS DISTRIBUTE"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP END TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP END TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_END_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP END TEAMS DISTRIBUTE SIMD"; + break; case ST_OMP_END_WORKSHARE: p = "!$OMP END WORKSHARE"; break; @@ -1584,6 +1834,9 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_PARALLEL_DO: p = "!$OMP PARALLEL DO"; break; + case ST_OMP_PARALLEL_DO_SIMD: + p = "!$OMP PARALLEL DO SIMD"; + break; case ST_OMP_PARALLEL_SECTIONS: p = "!$OMP PARALLEL SECTIONS"; break; @@ -1596,18 +1849,63 @@ gfc_ascii_statement (gfc_statement st) case ST_OMP_SECTION: p = "!$OMP SECTION"; break; + case ST_OMP_SIMD: + p = "!$OMP SIMD"; + break; case ST_OMP_SINGLE: p = "!$OMP SINGLE"; break; + case ST_OMP_TARGET: + p = "!$OMP TARGET"; + break; + case ST_OMP_TARGET_DATA: + p = "!$OMP TARGET DATA"; + break; + case ST_OMP_TARGET_TEAMS: + p = "!$OMP TARGET TEAMS"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + p = "!$OMP TARGET TEAMS DISTRIBUTE"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP TARGET TEAMS DISTRIBUTE SIMD"; + break; + case ST_OMP_TARGET_UPDATE: + p = "!$OMP TARGET UPDATE"; + break; case ST_OMP_TASK: p = "!$OMP TASK"; break; + case ST_OMP_TASKGROUP: + p = "!$OMP TASKGROUP"; + break; case ST_OMP_TASKWAIT: p = "!$OMP TASKWAIT"; break; case ST_OMP_TASKYIELD: p = "!$OMP TASKYIELD"; break; + case ST_OMP_TEAMS: + p = "!$OMP TEAMS"; + break; + case ST_OMP_TEAMS_DISTRIBUTE: + p = "!$OMP TEAMS DISTRIBUTE"; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + p = "!$OMP TEAMS DISTRIBUTE PARALLEL DO"; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + p = "!$OMP TEAMS DISTRIBUTE PARALLEL DO SIMD"; + break; + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + p = "!$OMP TEAMS DISTRIBUTE SIMD"; + break; case ST_OMP_THREADPRIVATE: p = "!$OMP THREADPRIVATE"; break; @@ -3578,7 +3876,53 @@ parse_omp_do (gfc_statement omp_st) pop_state (); st = next_statement (); - if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO)) + gfc_statement omp_end_st = ST_OMP_END_DO; + switch (omp_st) + { + case ST_OMP_DISTRIBUTE: omp_end_st = ST_OMP_END_DISTRIBUTE; break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD; + break; + case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break; + case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break; + case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break; + case ST_OMP_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD; + break; + case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; + break; + case ST_OMP_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD; + break; + default: gcc_unreachable (); + } + if (st == omp_end_st) { if (new_st.op == EXEC_OMP_END_NOWAIT) cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool; @@ -3610,7 +3954,8 @@ parse_omp_atomic (void) np = new_level (cp); np->op = cp->op; np->block = NULL; - count = 1 + (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE); + count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_CAPTURE); while (count) { @@ -3636,7 +3981,8 @@ parse_omp_atomic (void) gfc_warning_check (); st = next_statement (); } - else if (cp->ext.omp_atomic == GFC_OMP_ATOMIC_CAPTURE) + else if ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_CAPTURE) gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C"); return st; } @@ -3682,9 +4028,60 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case ST_OMP_SINGLE: omp_end_st = ST_OMP_END_SINGLE; break; + case ST_OMP_TARGET: + omp_end_st = ST_OMP_END_TARGET; + break; + case ST_OMP_TARGET_DATA: + omp_end_st = ST_OMP_END_TARGET_DATA; + break; + case ST_OMP_TARGET_TEAMS: + omp_end_st = ST_OMP_END_TARGET_TEAMS; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD; + break; case ST_OMP_TASK: omp_end_st = ST_OMP_END_TASK; break; + case ST_OMP_TASKGROUP: + omp_end_st = ST_OMP_END_TASKGROUP; + break; + case ST_OMP_TEAMS: + omp_end_st = ST_OMP_END_TEAMS; + break; + case ST_OMP_TEAMS_DISTRIBUTE: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD; + break; + case ST_OMP_DISTRIBUTE: + omp_end_st = ST_OMP_END_DISTRIBUTE; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO; + break; + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD; + break; + case ST_OMP_DISTRIBUTE_SIMD: + omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD; + break; case ST_OMP_WORKSHARE: omp_end_st = ST_OMP_END_WORKSHARE; break; @@ -3744,6 +4141,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) break; case ST_OMP_PARALLEL_DO: + case ST_OMP_PARALLEL_DO_SIMD: st = parse_omp_do (st); continue; @@ -3916,7 +4314,12 @@ parse_executable (gfc_statement st) case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: + case ST_OMP_TARGET: + case ST_OMP_TARGET_DATA: + case ST_OMP_TARGET_TEAMS: + case ST_OMP_TEAMS: case ST_OMP_TASK: + case ST_OMP_TASKGROUP: parse_omp_structured_block (st, false); break; @@ -3925,8 +4328,23 @@ parse_executable (gfc_statement st) parse_omp_structured_block (st, true); break; + case ST_OMP_DISTRIBUTE: + case ST_OMP_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_DISTRIBUTE_SIMD: case ST_OMP_DO: + case ST_OMP_DO_SIMD: case ST_OMP_PARALLEL_DO: + case ST_OMP_PARALLEL_DO_SIMD: + case ST_OMP_SIMD: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TEAMS_DISTRIBUTE: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: st = parse_omp_do (st); if (st == ST_IMPLIED_ENDDO) return st; diff --git a/gcc-4.9/gcc/fortran/resolve.c b/gcc-4.9/gcc/fortran/resolve.c index 38755fef6..c959f5d95 100644 --- a/gcc-4.9/gcc/fortran/resolve.c +++ b/gcc-4.9/gcc/fortran/resolve.c @@ -40,7 +40,7 @@ typedef enum seq_type seq_type; /* Stack to keep track of the nesting of blocks as we move through the - code. See resolve_branch() and resolve_code(). */ + code. See resolve_branch() and gfc_resolve_code(). */ typedef struct code_stack { @@ -2887,7 +2887,8 @@ resolve_function (gfc_expr *expr) /* See if function is already resolved. */ - if (expr->value.function.name != NULL) + if (expr->value.function.name != NULL + || expr->value.function.isym != NULL) { if (expr->ts.type == BT_UNKNOWN) expr->ts = sym->ts; @@ -4884,7 +4885,7 @@ resolve_variable (gfc_expr *e) if (check_assumed_size_reference (sym, e)) return false; - /* Deal with forward references to entries during resolve_code, to + /* Deal with forward references to entries during gfc_resolve_code, to satisfy, at least partially, 12.5.2.5. */ if (gfc_current_ns->entries && current_entry_id == sym->entry_id @@ -8926,8 +8927,6 @@ resolve_block_construct (gfc_code* code) /* Resolve lists of blocks found in IF, SELECT CASE, WHERE, FORALL, GOTO and DO code nodes. */ -static void resolve_code (gfc_code *, gfc_namespace *); - void gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { @@ -8979,18 +8978,39 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: break; @@ -8998,7 +9018,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) gfc_internal_error ("gfc_resolve_blocks(): Bad block type"); } - resolve_code (b->next, ns); + gfc_resolve_code (b->next, ns); } } @@ -9411,7 +9431,7 @@ nonscalar_typebound_assign (gfc_symbol *derived, int depth) The pointer assignments are taken care of by the intrinsic assignment of the structure itself. This function recursively adds defined assignments where required. The recursion is accomplished - by calling resolve_code. + by calling gfc_resolve_code. When the lhs in a defined assignment has intent INOUT, we need a temporary for the lhs. In pseudo-code: @@ -9529,9 +9549,9 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) comp1, comp2, (*code)->loc); /* Convert the assignment if there is a defined assignment for - this type. Otherwise, using the call from resolve_code, + this type. Otherwise, using the call from gfc_resolve_code, recurse into its components. */ - resolve_code (this_code, ns); + gfc_resolve_code (this_code, ns); if (this_code->op == EXEC_ASSIGN_CALL) { @@ -9695,8 +9715,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) /* Given a block of code, recursively resolve everything pointed to by this code block. */ -static void -resolve_code (gfc_code *code, gfc_namespace *ns) +void +gfc_resolve_code (gfc_code *code, gfc_namespace *ns) { int omp_workshare_save; int forall_save, do_concurrent_save; @@ -9733,13 +9753,28 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_parallel_blocks (code, ns); break; + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_SIMD: gfc_resolve_omp_do_blocks (code, ns); break; case EXEC_SELECT_TYPE: @@ -9960,7 +9995,8 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_DO_WHILE: if (code->expr1 == NULL) - gfc_internal_error ("resolve_code(): No expression on DO WHILE"); + gfc_internal_error ("gfc_resolve_code(): No expression on " + "DO WHILE"); if (t && (code->expr1->rank != 0 || code->expr1->ts.type != BT_LOGICAL)) @@ -10054,24 +10090,47 @@ resolve_code (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: case EXEC_OMP_FLUSH: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: + case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: gfc_resolve_omp_directive (code, ns); break; case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: - case EXEC_OMP_TASK: omp_workshare_save = omp_workshare_flag; omp_workshare_flag = 0; gfc_resolve_omp_directive (code, ns); @@ -10079,7 +10138,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) break; default: - gfc_internal_error ("resolve_code(): Bad statement code"); + gfc_internal_error ("gfc_resolve_code(): Bad statement code"); } } @@ -10779,7 +10838,10 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) } /* Constraints on deferred type parameter. */ - if (sym->ts.deferred && !(sym->attr.pointer || sym->attr.allocatable)) + if (sym->ts.deferred + && !(sym->attr.pointer + || sym->attr.allocatable + || sym->attr.omp_udr_artificial_var)) { gfc_error ("Entity '%s' at %L has a deferred type parameter and " "requires either the pointer or allocatable attribute", @@ -10794,7 +10856,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) dummy arguments. */ e = sym->ts.u.cl->length; if (e == NULL && !sym->attr.dummy && !sym->attr.result - && !sym->ts.deferred && !sym->attr.select_type_temporary) + && !sym->ts.deferred && !sym->attr.select_type_temporary + && !sym->attr.omp_udr_artificial_var) { gfc_error ("Entity with assumed character length at %L must be a " "dummy argument or a PARAMETER", &sym->declared_at); @@ -13429,6 +13492,18 @@ resolve_symbol (gfc_symbol *sym) || sym->ns->proc_name->attr.flavor != FL_MODULE))) gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at); + /* Check omp declare target restrictions. */ + if (sym->attr.omp_declare_target + && sym->attr.flavor == FL_VARIABLE + && !sym->attr.save + && !sym->ns->save_all + && (!sym->attr.in_common + && sym->module == NULL + && (sym->ns->proc_name == NULL + || sym->ns->proc_name->attr.flavor != FL_MODULE))) + gfc_error ("!$OMP DECLARE TARGET variable '%s' at %L isn't SAVEd", + sym->name, &sym->declared_at); + /* If we have come this far we can apply default-initializers, as described in 14.7.5, to those variables that have not already been assigned one. */ @@ -14526,7 +14601,7 @@ gfc_resolve_uops (gfc_symtree *symtree) assign types to all intermediate expressions, make sure that all assignments are to compatible types and figure out which names refer to which functions or subroutines. It doesn't check code - block, which is handled by resolve_code. */ + block, which is handled by gfc_resolve_code. */ static void resolve_types (gfc_namespace *ns) @@ -14607,11 +14682,15 @@ resolve_types (gfc_namespace *ns) gfc_resolve_uops (ns->uop_root); + gfc_resolve_omp_declare_simd (ns); + + gfc_resolve_omp_udrs (ns->omp_udr_root); + gfc_current_ns = old_ns; } -/* Call resolve_code recursively. */ +/* Call gfc_resolve_code recursively. */ static void resolve_codes (gfc_namespace *ns) @@ -14637,7 +14716,7 @@ resolve_codes (gfc_namespace *ns) old_obstack = labels_obstack; bitmap_obstack_initialize (&labels_obstack); - resolve_code (ns->code, ns); + gfc_resolve_code (ns->code, ns); bitmap_obstack_release (&labels_obstack); labels_obstack = old_obstack; diff --git a/gcc-4.9/gcc/fortran/scanner.c b/gcc-4.9/gcc/fortran/scanner.c index 8f5173421..8934924d8 100644 --- a/gcc-4.9/gcc/fortran/scanner.c +++ b/gcc-4.9/gcc/fortran/scanner.c @@ -752,7 +752,8 @@ skip_free_comments (void) 2) handle OpenMP conditional compilation, where !$ should be treated as 2 spaces (for initial lines only if followed by space). */ - if (gfc_option.gfc_flag_openmp && at_bol) + if ((gfc_option.gfc_flag_openmp + || gfc_option.gfc_flag_openmp_simd) && at_bol) { locus old_loc = gfc_current_locus; if (next_char () == '$') @@ -878,7 +879,7 @@ skip_fixed_comments (void) && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb)) continue_line = gfc_linebuf_linenum (gfc_current_locus.lb); - if (gfc_option.gfc_flag_openmp) + if (gfc_option.gfc_flag_openmp || gfc_option.gfc_flag_openmp_simd) { if (next_char () == '$') { @@ -1821,7 +1822,7 @@ include_line (gfc_char_t *line) c = line; - if (gfc_option.gfc_flag_openmp) + if (gfc_option.gfc_flag_openmp || gfc_option.gfc_flag_openmp_simd) { if (gfc_current_form == FORM_FREE) { diff --git a/gcc-4.9/gcc/fortran/st.c b/gcc-4.9/gcc/fortran/st.c index 0e1cc705e..0f18f7872 100644 --- a/gcc-4.9/gcc/fortran/st.c +++ b/gcc-4.9/gcc/fortran/st.c @@ -185,14 +185,36 @@ gfc_free_statement (gfc_code *p) gfc_free_forall_iterator (p->ext.forall_iterator); break; + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: case EXEC_OMP_END_SINGLE: case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: case EXEC_OMP_PARALLEL_WORKSHARE: gfc_free_omp_clauses (p->ext.omp_clauses); @@ -203,7 +225,7 @@ gfc_free_statement (gfc_code *p) break; case EXEC_OMP_FLUSH: - gfc_free_namelist (p->ext.omp_namelist); + gfc_free_omp_namelist (p->ext.omp_namelist); break; case EXEC_OMP_ATOMIC: @@ -211,6 +233,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OMP_MASTER: case EXEC_OMP_ORDERED: case EXEC_OMP_END_NOWAIT: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: break; diff --git a/gcc-4.9/gcc/fortran/symbol.c b/gcc-4.9/gcc/fortran/symbol.c index 19d792e08..8edd6931f 100644 --- a/gcc-4.9/gcc/fortran/symbol.c +++ b/gcc-4.9/gcc/fortran/symbol.c @@ -367,6 +367,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION", *contiguous = "CONTIGUOUS", *generic = "GENERIC"; static const char *threadprivate = "THREADPRIVATE"; + static const char *omp_declare_target = "OMP DECLARE TARGET"; const char *a1, *a2; int standard; @@ -453,6 +454,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, entry); conf (dummy, intrinsic); conf (dummy, threadprivate); + conf (dummy, omp_declare_target); conf (pointer, target); conf (pointer, intrinsic); conf (pointer, elemental); @@ -495,6 +497,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (in_equivalence, entry); conf (in_equivalence, allocatable); conf (in_equivalence, threadprivate); + conf (in_equivalence, omp_declare_target); conf (dummy, result); conf (entry, result); @@ -543,6 +546,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (cray_pointee, in_common); conf (cray_pointee, in_equivalence); conf (cray_pointee, threadprivate); + conf (cray_pointee, omp_declare_target); conf (data, dummy); conf (data, function); @@ -596,6 +600,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (proc_pointer, abstract) + conf (entry, omp_declare_target) + a1 = gfc_code2string (flavors, attr->flavor); if (attr->in_namelist @@ -631,6 +637,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (function); conf2 (subroutine); conf2 (threadprivate); + conf2 (omp_declare_target); if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE) { @@ -712,6 +719,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (subroutine); conf2 (threadprivate); conf2 (result); + conf2 (omp_declare_target); if (attr->intent != INTENT_UNKNOWN) { @@ -1207,6 +1215,22 @@ gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) bool +gfc_add_omp_declare_target (symbol_attribute *attr, const char *name, + locus *where) +{ + + if (check_used (attr, name, where)) + return false; + + if (attr->omp_declare_target) + return true; + + attr->omp_declare_target = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_target (symbol_attribute *attr, locus *where) { @@ -1761,6 +1785,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->threadprivate && !gfc_add_threadprivate (dest, NULL, where)) goto fail; + if (src->omp_declare_target + && !gfc_add_omp_declare_target (dest, NULL, where)) + goto fail; if (src->target && !gfc_add_target (dest, where)) goto fail; if (src->dummy && !gfc_add_dummy (dest, NULL, where)) @@ -2450,17 +2477,20 @@ gfc_get_uop (const char *name) { gfc_user_op *uop; gfc_symtree *st; + gfc_namespace *ns = gfc_current_ns; - st = gfc_find_symtree (gfc_current_ns->uop_root, name); + if (ns->omp_udr_ns) + ns = ns->parent; + st = gfc_find_symtree (ns->uop_root, name); if (st != NULL) return st->n.uop; - st = gfc_new_symtree (&gfc_current_ns->uop_root, name); + st = gfc_new_symtree (&ns->uop_root, name); uop = st->n.uop = XCNEW (gfc_user_op); uop->name = gfc_get_string (name); uop->access = ACCESS_UNKNOWN; - uop->ns = gfc_current_ns; + uop->ns = ns; return uop; } @@ -2771,6 +2801,12 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result, /* Try to find the symbol in ns. */ st = gfc_find_symtree (ns->sym_root, name); + if (st == NULL && ns->omp_udr_ns) + { + ns = ns->parent; + st = gfc_find_symtree (ns->sym_root, name); + } + if (st == NULL) { /* If not there, create a new symbol. */ @@ -3269,6 +3305,23 @@ free_common_tree (gfc_symtree * common_tree) } +/* Recursive function that deletes an entire tree and all the common + head structures it points to. */ + +static void +free_omp_udr_tree (gfc_symtree * omp_udr_tree) +{ + if (omp_udr_tree == NULL) + return; + + free_omp_udr_tree (omp_udr_tree->left); + free_omp_udr_tree (omp_udr_tree->right); + + gfc_free_omp_udr (omp_udr_tree->n.omp_udr); + free (omp_udr_tree); +} + + /* Recursive function that deletes an entire tree and all the user operator nodes that it contains. */ @@ -3465,9 +3518,11 @@ gfc_free_namespace (gfc_namespace *ns) free_sym_tree (ns->sym_root); free_uop_tree (ns->uop_root); free_common_tree (ns->common_root); + free_omp_udr_tree (ns->omp_udr_root); free_tb_tree (ns->tb_sym_root); free_tb_tree (ns->tb_uop_root); gfc_free_finalizer_list (ns->finalizers); + gfc_free_omp_declare_simd_list (ns->omp_declare_simd); gfc_free_charlen (ns->cl_list, NULL); free_st_labels (ns->st_labels); diff --git a/gcc-4.9/gcc/fortran/trans-array.c b/gcc-4.9/gcc/fortran/trans-array.c index 850277747..a36db45c0 100644 --- a/gcc-4.9/gcc/fortran/trans-array.c +++ b/gcc-4.9/gcc/fortran/trans-array.c @@ -7389,8 +7389,8 @@ gfc_trans_dealloc_allocated (tree descriptor, bool coarray, gfc_expr *expr) /* This helper function calculates the size in words of a full array. */ -static tree -get_full_array_size (stmtblock_t *block, tree decl, int rank) +tree +gfc_full_array_size (stmtblock_t *block, tree decl, int rank) { tree idx; tree nelems; @@ -7416,7 +7416,7 @@ get_full_array_size (stmtblock_t *block, tree decl, int rank) static tree duplicate_allocatable (tree dest, tree src, tree type, int rank, - bool no_malloc, tree str_sz) + bool no_malloc, bool no_memcpy, tree str_sz) { tree tmp; tree size; @@ -7450,9 +7450,13 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, gfc_add_expr_to_block (&block, tmp); } - tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); - tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, - fold_convert (size_type_node, size)); + if (!no_memcpy) + { + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); + tmp = build_call_expr_loc (input_location, tmp, 3, dest, src, + fold_convert (size_type_node, size)); + gfc_add_expr_to_block (&block, tmp); + } } else { @@ -7461,7 +7465,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, gfc_init_block (&block); if (rank) - nelems = get_full_array_size (&block, src, rank); + nelems = gfc_full_array_size (&block, src, rank); else nelems = gfc_index_one_node; @@ -7481,14 +7485,17 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, /* We know the temporary and the value will be the same length, so can use memcpy. */ - tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); - tmp = build_call_expr_loc (input_location, - tmp, 3, gfc_conv_descriptor_data_get (dest), - gfc_conv_descriptor_data_get (src), - fold_convert (size_type_node, size)); + if (!no_memcpy) + { + tmp = builtin_decl_explicit (BUILT_IN_MEMCPY); + tmp = build_call_expr_loc (input_location, tmp, 3, + gfc_conv_descriptor_data_get (dest), + gfc_conv_descriptor_data_get (src), + fold_convert (size_type_node, size)); + gfc_add_expr_to_block (&block, tmp); + } } - gfc_add_expr_to_block (&block, tmp); tmp = gfc_finish_block (&block); /* Null the destination if the source is null; otherwise do @@ -7510,7 +7517,8 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, false, NULL_TREE); + return duplicate_allocatable (dest, src, type, rank, false, false, + NULL_TREE); } @@ -7519,7 +7527,16 @@ gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank) tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank) { - return duplicate_allocatable (dest, src, type, rank, true, NULL_TREE); + return duplicate_allocatable (dest, src, type, rank, true, false, + NULL_TREE); +} + +/* Allocate dest to the same size as src, but don't copy anything. */ + +tree +gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank) +{ + return duplicate_allocatable (dest, src, type, rank, false, true, NULL_TREE); } @@ -7579,7 +7596,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, /* Use the descriptor for an allocatable array. Since this is a full array reference, we only need the descriptor information from dimension = rank. */ - tmp = get_full_array_size (&fnblock, decl, rank); + tmp = gfc_full_array_size (&fnblock, decl, rank); tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, gfc_index_one_node); @@ -7938,7 +7955,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_add_expr_to_block (&fnblock, tmp); size = size_of_string_in_bytes (c->ts.kind, len); tmp = duplicate_allocatable (dcmp, comp, ctype, rank, - false, size); + false, false, size); gfc_add_expr_to_block (&fnblock, tmp); } else if (c->attr.allocatable && !c->attr.proc_pointer diff --git a/gcc-4.9/gcc/fortran/trans-array.h b/gcc-4.9/gcc/fortran/trans-array.h index c4c09c1c5..e0bb82071 100644 --- a/gcc-4.9/gcc/fortran/trans-array.h +++ b/gcc-4.9/gcc/fortran/trans-array.h @@ -44,10 +44,14 @@ void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *); /* Generate code to deallocate an array, if it is allocated. */ tree gfc_trans_dealloc_allocated (tree, bool, gfc_expr *); +tree gfc_full_array_size (stmtblock_t *, tree, int); + tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank); tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank); +tree gfc_duplicate_allocatable_nocopy (tree, tree, tree, int); + tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int); tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int); diff --git a/gcc-4.9/gcc/fortran/trans-common.c b/gcc-4.9/gcc/fortran/trans-common.c index 19eaddae2..bb66abc36 100644 --- a/gcc-4.9/gcc/fortran/trans-common.c +++ b/gcc-4.9/gcc/fortran/trans-common.c @@ -456,6 +456,11 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) if (com->threadprivate) DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); + if (com->omp_declare_target) + DECL_ATTRIBUTES (decl) + = tree_cons (get_identifier ("omp declare target"), + NULL_TREE, DECL_ATTRIBUTES (decl)); + /* Place the back end declaration for this common block in GLOBAL_BINDING_LEVEL. */ gfc_map_of_all_commons[identifier] = pushdecl_top_level (decl); @@ -705,6 +710,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv) TREE_ADDRESSABLE (var_decl) = 1; /* Fake variables are not visible from other translation units. */ TREE_PUBLIC (var_decl) = 0; + gfc_finish_decl_attrs (var_decl, &s->sym->attr); /* To preserve identifier names in COMMON, chain to procedure scope unless at top level in a module definition. */ diff --git a/gcc-4.9/gcc/fortran/trans-decl.c b/gcc-4.9/gcc/fortran/trans-decl.c index cf7b661d8..2b0667960 100644 --- a/gcc-4.9/gcc/fortran/trans-decl.c +++ b/gcc-4.9/gcc/fortran/trans-decl.c @@ -496,6 +496,29 @@ gfc_finish_decl (tree decl) } +/* Handle setting of GFC_DECL_SCALAR* on DECL. */ + +void +gfc_finish_decl_attrs (tree decl, symbol_attribute *attr) +{ + if (!attr->dimension && !attr->codimension) + { + /* Handle scalar allocatable variables. */ + if (attr->allocatable) + { + gfc_allocate_lang_decl (decl); + GFC_DECL_SCALAR_ALLOCATABLE (decl) = 1; + } + /* Handle scalar pointer variables. */ + if (attr->pointer) + { + gfc_allocate_lang_decl (decl); + GFC_DECL_SCALAR_POINTER (decl) = 1; + } + } +} + + /* Apply symbol attributes to a variable, and add it to the function scope. */ static void @@ -607,6 +630,8 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) if (sym->attr.threadprivate && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) DECL_TLS_MODEL (decl) = decl_default_tls_model (decl); + + gfc_finish_decl_attrs (decl, &sym->attr); } @@ -615,8 +640,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) void gfc_allocate_lang_decl (tree decl) { - DECL_LANG_SPECIFIC (decl) = ggc_alloc_cleared_lang_decl(sizeof - (struct lang_decl)); + if (DECL_LANG_SPECIFIC (decl) == NULL) + DECL_LANG_SPECIFIC (decl) + = ggc_alloc_cleared_lang_decl (sizeof (struct lang_decl)); } /* Remember a symbol to generate initialization/cleanup code at function @@ -1192,6 +1218,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = chainon (list, attr); } + if (sym_attr.omp_declare_target) + list = tree_cons (get_identifier ("omp declare target"), + NULL_TREE, list); + return list; } @@ -1518,6 +1548,9 @@ gfc_get_symbol_decl (gfc_symbol * sym) && !sym->attr.select_type_temporary) DECL_BY_REFERENCE (decl) = 1; + if (sym->attr.associate_var) + GFC_DECL_ASSOCIATE_VAR_P (decl) = 1; + if (sym->attr.vtab || (sym->name[0] == '_' && strncmp ("__def_init", sym->name, 10) == 0)) TREE_READONLY (decl) = 1; @@ -1850,6 +1883,11 @@ module_sym: if (DECL_CONTEXT (fndecl) == NULL_TREE) pushdecl_top_level (fndecl); + if (sym->formal_ns + && sym->formal_ns->proc_name == sym + && sym->formal_ns->omp_declare_simd) + gfc_trans_omp_declare_simd (sym->formal_ns); + return fndecl; } @@ -2232,6 +2270,7 @@ create_function_arglist (gfc_symbol * sym) DECL_BY_REFERENCE (parm) = 1; gfc_finish_decl (parm); + gfc_finish_decl_attrs (parm, &f->sym->attr); f->sym->backend_decl = parm; @@ -2544,6 +2583,9 @@ gfc_create_function_decl (gfc_namespace * ns, bool global) /* Now create the read argument list. */ create_function_arglist (ns->proc_name); + + if (ns->omp_declare_simd) + gfc_trans_omp_declare_simd (ns); } /* Return the decl used to hold the function return value. If @@ -2672,6 +2714,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) TREE_ADDRESSABLE (decl) = 1; layout_decl (decl, 0); + gfc_finish_decl_attrs (decl, &sym->attr); if (parent_flag) gfc_add_decl_to_parent_function (decl); @@ -4237,8 +4280,8 @@ gfc_create_module_variable (gfc_symbol * sym) } /* Don't generate variables from other modules. Variables from - COMMONs will already have been generated. */ - if (sym->attr.use_assoc || sym->attr.in_common) + COMMONs and Cray pointees will already have been generated. */ + if (sym->attr.use_assoc || sym->attr.in_common || sym->attr.cray_pointee) return; /* Equivalenced variables arrive here after creation. */ diff --git a/gcc-4.9/gcc/fortran/trans-expr.c b/gcc-4.9/gcc/fortran/trans-expr.c index 955102b04..dbfde1bdc 100644 --- a/gcc-4.9/gcc/fortran/trans-expr.c +++ b/gcc-4.9/gcc/fortran/trans-expr.c @@ -6472,6 +6472,20 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) /* Take the address of that value. */ se->expr = gfc_build_addr_expr (NULL_TREE, var); + if (expr->ts.type == BT_DERIVED && expr->rank + && !gfc_is_finalizable (expr->ts.u.derived, NULL) + && expr->ts.u.derived->attr.alloc_comp + && expr->expr_type != EXPR_VARIABLE) + { + tree tmp; + + tmp = build_fold_indirect_ref_loc (input_location, se->expr); + tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank); + + /* The components shall be deallocated before + their containing entity. */ + gfc_prepend_expr_to_block (&se->post, tmp); + } } @@ -7251,7 +7265,7 @@ fcncall_realloc_result (gfc_se *se, int rank) res_desc = gfc_evaluate_now (desc, &se->pre); gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node); - se->expr = gfc_build_addr_expr (TREE_TYPE (se->expr), res_desc); + se->expr = gfc_build_addr_expr (NULL_TREE, res_desc); /* Free the lhs after the function call and copy the result data to the lhs descriptor. */ diff --git a/gcc-4.9/gcc/fortran/trans-openmp.c b/gcc-4.9/gcc/fortran/trans-openmp.c index 41020a836..da01a9034 100644 --- a/gcc-4.9/gcc/fortran/trans-openmp.c +++ b/gcc-4.9/gcc/fortran/trans-openmp.c @@ -53,9 +53,13 @@ gfc_omp_privatize_by_reference (const_tree decl) if (TREE_CODE (type) == POINTER_TYPE) { /* Array POINTER/ALLOCATABLE have aggregate types, all user variables - that have POINTER_TYPE type and don't have GFC_POINTER_TYPE_P - set are supposed to be privatized by reference. */ - if (GFC_POINTER_TYPE_P (type)) + that have POINTER_TYPE type and aren't scalar pointers, scalar + allocatables, Cray pointees or C pointers are supposed to be + privatized by reference. */ + if (GFC_DECL_GET_SCALAR_POINTER (decl) + || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + || GFC_DECL_CRAY_POINTEE (decl) + || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) return false; if (!DECL_ARTIFICIAL (decl) @@ -77,6 +81,19 @@ gfc_omp_privatize_by_reference (const_tree decl) enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree decl) { + /* Associate names preserve the association established during ASSOCIATE. + As they are implemented either as pointers to the selector or array + descriptor and shouldn't really change in the ASSOCIATE region, + this decl can be either shared or firstprivate. If it is a pointer, + use firstprivate, as it is cheaper that way, otherwise make it shared. */ + if (GFC_DECL_ASSOCIATE_VAR_P (decl)) + { + if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) + return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE; + else + return OMP_CLAUSE_DEFAULT_SHARED; + } + if (DECL_ARTIFICIAL (decl) && ! GFC_DECL_RESULT (decl) && ! (DECL_LANG_SPECIFIC (decl) @@ -135,6 +152,41 @@ gfc_omp_report_decl (tree decl) return decl; } +/* Return true if TYPE has any allocatable components. */ + +static bool +gfc_has_alloc_comps (tree type, tree decl) +{ + tree field, ftype; + + if (POINTER_TYPE_P (type)) + { + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)) + type = TREE_TYPE (type); + else if (GFC_DECL_GET_SCALAR_POINTER (decl)) + return false; + } + + while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)) + type = gfc_get_element_type (type); + + if (TREE_CODE (type) != RECORD_TYPE) + return false; + + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) + { + ftype = TREE_TYPE (field); + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + return true; + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + return true; + if (gfc_has_alloc_comps (ftype, field)) + return true; + } + return false; +} + /* Return true if DECL in private clause needs OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */ bool @@ -146,68 +198,335 @@ gfc_omp_private_outer_ref (tree decl) && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) return true; + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)) + return true; + + if (gfc_omp_privatize_by_reference (decl)) + type = TREE_TYPE (type); + + if (gfc_has_alloc_comps (type, decl)) + return true; + return false; } +/* Callback for gfc_omp_unshare_expr. */ + +static tree +gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *) +{ + tree t = *tp; + enum tree_code code = TREE_CODE (t); + + /* Stop at types, decls, constants like copy_tree_r. */ + if (TREE_CODE_CLASS (code) == tcc_type + || TREE_CODE_CLASS (code) == tcc_declaration + || TREE_CODE_CLASS (code) == tcc_constant + || code == BLOCK) + *walk_subtrees = 0; + else if (handled_component_p (t) + || TREE_CODE (t) == MEM_REF) + { + *tp = unshare_expr (t); + *walk_subtrees = 0; + } + + return NULL_TREE; +} + +/* Unshare in expr anything that the FE which normally doesn't + care much about tree sharing (because during gimplification + everything is unshared) could cause problems with tree sharing + at omp-low.c time. */ + +static tree +gfc_omp_unshare_expr (tree expr) +{ + walk_tree (&expr, gfc_omp_unshare_expr_r, NULL, NULL); + return expr; +} + +enum walk_alloc_comps +{ + WALK_ALLOC_COMPS_DTOR, + WALK_ALLOC_COMPS_DEFAULT_CTOR, + WALK_ALLOC_COMPS_COPY_CTOR +}; + +/* Handle allocatable components in OpenMP clauses. */ + +static tree +gfc_walk_alloc_comps (tree decl, tree dest, tree var, + enum walk_alloc_comps kind) +{ + stmtblock_t block, tmpblock; + tree type = TREE_TYPE (decl), then_b, tem, field; + gfc_init_block (&block); + + if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type)) + { + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_init_block (&tmpblock); + tem = gfc_full_array_size (&tmpblock, decl, + GFC_TYPE_ARRAY_RANK (type)); + then_b = gfc_finish_block (&tmpblock); + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (then_b)); + tem = gfc_omp_unshare_expr (tem); + tem = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, tem, + gfc_index_one_node); + } + else + { + if (!TYPE_DOMAIN (type) + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE + || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node) + { + tem = fold_build2 (EXACT_DIV_EXPR, sizetype, + TYPE_SIZE_UNIT (type), + TYPE_SIZE_UNIT (TREE_TYPE (type))); + tem = size_binop (MINUS_EXPR, tem, size_one_node); + } + else + tem = array_type_nelts (type); + tem = fold_convert (gfc_array_index_type, tem); + } + + tree nelems = gfc_evaluate_now (tem, &block); + tree index = gfc_create_var (gfc_array_index_type, "S"); + + gfc_init_block (&tmpblock); + tem = gfc_conv_array_data (decl); + tree declvar = build_fold_indirect_ref_loc (input_location, tem); + tree declvref = gfc_build_array_ref (declvar, index, NULL); + tree destvar, destvref = NULL_TREE; + if (dest) + { + tem = gfc_conv_array_data (dest); + destvar = build_fold_indirect_ref_loc (input_location, tem); + destvref = gfc_build_array_ref (destvar, index, NULL); + } + gfc_add_expr_to_block (&tmpblock, + gfc_walk_alloc_comps (declvref, destvref, + var, kind)); + + gfc_loopinfo loop; + gfc_init_loopinfo (&loop); + loop.dimen = 1; + loop.from[0] = gfc_index_zero_node; + loop.loopvar[0] = index; + loop.to[0] = nelems; + gfc_trans_scalarizing_loops (&loop, &tmpblock); + gfc_add_block_to_block (&block, &loop.pre); + return gfc_finish_block (&block); + } + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (var)) + { + decl = build_fold_indirect_ref_loc (input_location, decl); + if (dest) + dest = build_fold_indirect_ref_loc (input_location, dest); + type = TREE_TYPE (decl); + } + + gcc_assert (TREE_CODE (type) == RECORD_TYPE); + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) + { + tree ftype = TREE_TYPE (field); + tree declf, destf = NULL_TREE; + bool has_alloc_comps = gfc_has_alloc_comps (ftype, field); + if ((!GFC_DESCRIPTOR_TYPE_P (ftype) + || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field) + && !has_alloc_comps) + continue; + declf = fold_build3_loc (input_location, COMPONENT_REF, ftype, + decl, field, NULL_TREE); + if (dest) + destf = fold_build3_loc (input_location, COMPONENT_REF, ftype, + dest, field, NULL_TREE); + + tem = NULL_TREE; + switch (kind) + { + case WALK_ALLOC_COMPS_DTOR: + break; + case WALK_ALLOC_COMPS_DEFAULT_CTOR: + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + { + gfc_add_modify (&block, unshare_expr (destf), + unshare_expr (declf)); + tem = gfc_duplicate_allocatable_nocopy + (destf, declf, ftype, + GFC_TYPE_ARRAY_RANK (ftype)); + } + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + tem = gfc_duplicate_allocatable_nocopy (destf, declf, ftype, 0); + break; + case WALK_ALLOC_COMPS_COPY_CTOR: + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + tem = gfc_duplicate_allocatable (destf, declf, ftype, + GFC_TYPE_ARRAY_RANK (ftype)); + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + tem = gfc_duplicate_allocatable (destf, declf, ftype, 0); + break; + } + if (tem) + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); + if (has_alloc_comps) + { + gfc_init_block (&tmpblock); + gfc_add_expr_to_block (&tmpblock, + gfc_walk_alloc_comps (declf, destf, + field, kind)); + then_b = gfc_finish_block (&tmpblock); + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + tem = gfc_conv_descriptor_data_get (unshare_expr (declf)); + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + tem = unshare_expr (declf); + else + tem = NULL_TREE; + if (tem) + { + tem = fold_convert (pvoid_type_node, tem); + tem = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tem, + null_pointer_node); + then_b = build3_loc (input_location, COND_EXPR, void_type_node, + tem, then_b, + build_empty_stmt (input_location)); + } + gfc_add_expr_to_block (&block, then_b); + } + if (kind == WALK_ALLOC_COMPS_DTOR) + { + if (GFC_DESCRIPTOR_TYPE_P (ftype) + && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE) + { + tem = gfc_trans_dealloc_allocated (unshare_expr (declf), + false, NULL); + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); + } + else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field)) + { + tem = gfc_call_free (unshare_expr (declf)); + gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem)); + } + } + } + + return gfc_finish_block (&block); +} + /* Return code to initialize DECL with its default constructor, or NULL if there's nothing to do. */ tree gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) { - tree type = TREE_TYPE (decl), rank, size, esize, ptr, cond, then_b, else_b; + tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b; stmtblock_t block, cond_block; - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return NULL; + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION); - if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION) - return NULL; + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + gcc_assert (outer); + gfc_start_block (&block); + tree tem = gfc_walk_alloc_comps (outer, decl, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DEFAULT_CTOR); + gfc_add_expr_to_block (&block, tem); + return gfc_finish_block (&block); + } + return NULL_TREE; + } - gcc_assert (outer != NULL); - gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE - || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE); + gcc_assert (outer != NULL_TREE); - /* Allocatable arrays in PRIVATE clauses need to be set to + /* Allocatable arrays and scalars in PRIVATE clauses need to be set to "not currently allocated" allocation status if outer array is "not currently allocated", otherwise should be allocated. */ gfc_start_block (&block); gfc_init_block (&cond_block); - gfc_add_modify (&cond_block, decl, outer); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (decl, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_lbound_get (decl, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_stride_get (decl, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); - + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_add_modify (&cond_block, decl, outer); + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (decl, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (decl, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (decl, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, esize); + size = unshare_expr (size); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &cond_block); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); ptr = gfc_create_var (pvoid_type_node, NULL); gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE); - gfc_conv_descriptor_data_set (&cond_block, decl, ptr); - + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), ptr); + else + gfc_add_modify (&cond_block, unshare_expr (decl), + fold_convert (TREE_TYPE (decl), ptr)); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + tree tem = gfc_walk_alloc_comps (outer, decl, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DEFAULT_CTOR); + gfc_add_expr_to_block (&cond_block, tem); + } then_b = gfc_finish_block (&cond_block); - gfc_init_block (&cond_block); - gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node); - else_b = gfc_finish_block (&cond_block); - - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (outer)), - null_pointer_node); - gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, - void_type_node, cond, then_b, else_b)); + /* Reduction clause requires allocated ALLOCATABLE. */ + if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_REDUCTION) + { + gfc_init_block (&cond_block); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), + null_pointer_node); + else + gfc_add_modify (&cond_block, unshare_expr (decl), + build_zero_cst (TREE_TYPE (decl))); + else_b = gfc_finish_block (&cond_block); + + tree tem = fold_convert (pvoid_type_node, + GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (outer) : outer); + tem = unshare_expr (tem); + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, null_pointer_node); + gfc_add_expr_to_block (&block, + build3_loc (input_location, COND_EXPR, + void_type_node, cond, then_b, + else_b)); + } + else + gfc_add_expr_to_block (&block, then_b); return gfc_finish_block (&block); } @@ -217,15 +536,29 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) tree gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) { - tree type = TREE_TYPE (dest), ptr, size, esize, rank, call; + tree type = TREE_TYPE (dest), ptr, size, call; tree cond, then_b, else_b; stmtblock_t block, cond_block; - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return build2_v (MODIFY_EXPR, dest, src); + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE + || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR); - gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE); + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + gfc_start_block (&block); + gfc_add_modify (&block, dest, src); + tree tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&block, tem); + return gfc_finish_block (&block); + } + else + return build2_v (MODIFY_EXPR, dest, src); + } /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated and copied from SRC. */ @@ -234,86 +567,389 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) gfc_init_block (&cond_block); gfc_add_modify (&cond_block, dest, src); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (dest, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_lbound_get (dest, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_stride_get (dest, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block); - + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (dest, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (dest, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (dest, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, esize); + size = unshare_expr (size); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &cond_block); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); ptr = gfc_create_var (pvoid_type_node, NULL); gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE); - gfc_conv_descriptor_data_set (&cond_block, dest, ptr); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), ptr); + else + gfc_add_modify (&cond_block, unshare_expr (dest), + fold_convert (TREE_TYPE (dest), ptr)); + tree srcptr = GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (src) : src; + srcptr = unshare_expr (srcptr); + srcptr = fold_convert (pvoid_type_node, srcptr); call = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMCPY), - 3, ptr, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (src)), - size); + builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr, + srcptr, size); gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call)); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + tree tem = gfc_walk_alloc_comps (src, dest, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&cond_block, tem); + } then_b = gfc_finish_block (&cond_block); gfc_init_block (&cond_block); - gfc_conv_descriptor_data_set (&cond_block, dest, null_pointer_node); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), + null_pointer_node); + else + gfc_add_modify (&cond_block, unshare_expr (dest), + build_zero_cst (TREE_TYPE (dest))); else_b = gfc_finish_block (&cond_block); cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (src)), - null_pointer_node); - gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, - void_type_node, cond, then_b, else_b)); + unshare_expr (srcptr), null_pointer_node); + gfc_add_expr_to_block (&block, + build3_loc (input_location, COND_EXPR, + void_type_node, cond, then_b, else_b)); return gfc_finish_block (&block); } -/* Similarly, except use an assignment operator instead. */ +/* Similarly, except use an intrinsic or pointer assignment operator + instead. */ tree -gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src) +gfc_omp_clause_assign_op (tree clause, tree dest, tree src) { - tree type = TREE_TYPE (dest), rank, size, esize, call; - stmtblock_t block; + tree type = TREE_TYPE (dest), ptr, size, call, nonalloc; + tree cond, then_b, else_b; + stmtblock_t block, cond_block, cond_block2, inner_block; - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return build2_v (MODIFY_EXPR, dest, src); + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + gfc_start_block (&block); + /* First dealloc any allocatable components in DEST. */ + tree tem = gfc_walk_alloc_comps (dest, NULL_TREE, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR); + gfc_add_expr_to_block (&block, tem); + /* Then copy over toplevel data. */ + gfc_add_modify (&block, dest, src); + /* Finally allocate any allocatable components and copy. */ + tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&block, tem); + return gfc_finish_block (&block); + } + else + return build2_v (MODIFY_EXPR, dest, src); + } - /* Handle copying allocatable arrays. */ gfc_start_block (&block); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (dest, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_lbound_get (dest, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, gfc_conv_descriptor_stride_get (dest, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR); + tree tem = fold_convert (pvoid_type_node, + GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (dest) : dest); + tem = unshare_expr (tem); + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, null_pointer_node); + tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, + then_b, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tem); + } + + gfc_init_block (&cond_block); + + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (src, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (src, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (src, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + size, esize); + size = unshare_expr (size); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &cond_block); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); + ptr = gfc_create_var (pvoid_type_node, NULL); + + tree destptr = GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (dest) : dest; + destptr = unshare_expr (destptr); + destptr = fold_convert (pvoid_type_node, destptr); + gfc_add_modify (&cond_block, ptr, destptr); + + nonalloc = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + destptr, null_pointer_node); + cond = nonalloc; + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + int i; + for (i = 0; i < GFC_TYPE_ARRAY_RANK (type); i++) + { + tree rank = gfc_rank_cst[i]; + tree tem = gfc_conv_descriptor_ubound_get (src, rank); + tem = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, tem, + gfc_conv_descriptor_lbound_get (src, rank)); + tem = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tem, + gfc_conv_descriptor_lbound_get (dest, rank)); + tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, gfc_conv_descriptor_ubound_get (dest, + rank)); + cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + boolean_type_node, cond, tem); + } + } + + gfc_init_block (&cond_block2); + + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_init_block (&inner_block); + gfc_allocate_using_malloc (&inner_block, ptr, size, NULL_TREE); + then_b = gfc_finish_block (&inner_block); + + gfc_init_block (&inner_block); + gfc_add_modify (&inner_block, ptr, + gfc_call_realloc (&inner_block, ptr, size)); + else_b = gfc_finish_block (&inner_block); + + gfc_add_expr_to_block (&cond_block2, + build3_loc (input_location, COND_EXPR, + void_type_node, + unshare_expr (nonalloc), + then_b, else_b)); + gfc_add_modify (&cond_block2, dest, src); + gfc_conv_descriptor_data_set (&cond_block2, unshare_expr (dest), ptr); + } + else + { + gfc_allocate_using_malloc (&cond_block2, ptr, size, NULL_TREE); + gfc_add_modify (&cond_block2, unshare_expr (dest), + fold_convert (type, ptr)); + } + then_b = gfc_finish_block (&cond_block2); + else_b = build_empty_stmt (input_location); + + gfc_add_expr_to_block (&cond_block, + build3_loc (input_location, COND_EXPR, + void_type_node, unshare_expr (cond), + then_b, else_b)); + + tree srcptr = GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (src) : src; + srcptr = unshare_expr (srcptr); + srcptr = fold_convert (pvoid_type_node, srcptr); call = build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMCPY), 3, - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (dest)), - fold_convert (pvoid_type_node, - gfc_conv_descriptor_data_get (src)), - size); - gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)); + builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr, + srcptr, size); + gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call)); + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + tree tem = gfc_walk_alloc_comps (src, dest, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_COPY_CTOR); + gfc_add_expr_to_block (&cond_block, tem); + } + then_b = gfc_finish_block (&cond_block); + + if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_COPYIN) + { + gfc_init_block (&cond_block); + if (GFC_DESCRIPTOR_TYPE_P (type)) + gfc_add_expr_to_block (&cond_block, + gfc_trans_dealloc_allocated (unshare_expr (dest), + false, NULL)); + else + { + destptr = gfc_evaluate_now (destptr, &cond_block); + gfc_add_expr_to_block (&cond_block, gfc_call_free (destptr)); + gfc_add_modify (&cond_block, unshare_expr (dest), + build_zero_cst (TREE_TYPE (dest))); + } + else_b = gfc_finish_block (&cond_block); + + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + unshare_expr (srcptr), null_pointer_node); + gfc_add_expr_to_block (&block, + build3_loc (input_location, COND_EXPR, + void_type_node, cond, + then_b, else_b)); + } + else + gfc_add_expr_to_block (&block, then_b); + + return gfc_finish_block (&block); +} + +static void +gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src, + tree add, tree nelems) +{ + stmtblock_t tmpblock; + tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S"); + nelems = gfc_evaluate_now (nelems, block); + + gfc_init_block (&tmpblock); + if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE) + { + desta = gfc_build_array_ref (dest, index, NULL); + srca = gfc_build_array_ref (src, index, NULL); + } + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest))); + tree idx = fold_build2 (MULT_EXPR, sizetype, + fold_convert (sizetype, index), + TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest)))); + desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR, + TREE_TYPE (dest), dest, + idx)); + srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR, + TREE_TYPE (src), src, + idx)); + } + gfc_add_modify (&tmpblock, desta, + fold_build2 (PLUS_EXPR, TREE_TYPE (desta), + srca, add)); + + gfc_loopinfo loop; + gfc_init_loopinfo (&loop); + loop.dimen = 1; + loop.from[0] = gfc_index_zero_node; + loop.loopvar[0] = index; + loop.to[0] = nelems; + gfc_trans_scalarizing_loops (&loop, &tmpblock); + gfc_add_block_to_block (block, &loop.pre); +} + +/* Build and return code for a constructor of DEST that initializes + it to SRC plus ADD (ADD is scalar integer). */ + +tree +gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add) +{ + tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE; + stmtblock_t block; + + gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR); + gfc_start_block (&block); + add = gfc_evaluate_now (add, &block); + + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + gcc_assert (TREE_CODE (type) == ARRAY_TYPE); + if (!TYPE_DOMAIN (type) + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE + || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node + || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node) + { + nelems = fold_build2 (EXACT_DIV_EXPR, sizetype, + TYPE_SIZE_UNIT (type), + TYPE_SIZE_UNIT (TREE_TYPE (type))); + nelems = size_binop (MINUS_EXPR, nelems, size_one_node); + } + else + nelems = array_type_nelts (type); + nelems = fold_convert (gfc_array_index_type, nelems); + + gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems); + return gfc_finish_block (&block); + } + + /* Allocatable arrays in LINEAR clauses need to be allocated + and copied from SRC. */ + gfc_add_modify (&block, dest, src); + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; + size = gfc_conv_descriptor_ubound_get (dest, rank); + size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + size, + gfc_conv_descriptor_lbound_get (dest, rank)); + size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, + size, gfc_index_one_node); + if (GFC_TYPE_ARRAY_RANK (type) > 1) + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, + gfc_conv_descriptor_stride_get (dest, rank)); + tree esize = fold_convert (gfc_array_index_type, + TYPE_SIZE_UNIT (gfc_get_element_type (type))); + nelems = gfc_evaluate_now (unshare_expr (size), &block); + size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, + nelems, unshare_expr (esize)); + size = gfc_evaluate_now (fold_convert (size_type_node, size), + &block); + nelems = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, nelems, + gfc_index_one_node); + } + else + size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type))); + ptr = gfc_create_var (pvoid_type_node, NULL); + gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE); + if (GFC_DESCRIPTOR_TYPE_P (type)) + { + gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr); + tree etype = gfc_get_element_type (type); + ptr = fold_convert (build_pointer_type (etype), ptr); + tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src)); + srcptr = fold_convert (build_pointer_type (etype), srcptr); + gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems); + } + else + { + gfc_add_modify (&block, unshare_expr (dest), + fold_convert (TREE_TYPE (dest), ptr)); + ptr = fold_convert (TREE_TYPE (dest), ptr); + tree dstm = build_fold_indirect_ref (ptr); + tree srcm = build_fold_indirect_ref (unshare_expr (src)); + gfc_add_modify (&block, dstm, + fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add)); + } return gfc_finish_block (&block); } @@ -321,20 +957,161 @@ gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src) to be done. */ tree -gfc_omp_clause_dtor (tree clause ATTRIBUTE_UNUSED, tree decl) +gfc_omp_clause_dtor (tree clause, tree decl) { - tree type = TREE_TYPE (decl); + tree type = TREE_TYPE (decl), tem; + + if ((! GFC_DESCRIPTOR_TYPE_P (type) + || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))) + { + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + return gfc_walk_alloc_comps (decl, NULL_TREE, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR); + return NULL_TREE; + } - if (! GFC_DESCRIPTOR_TYPE_P (type) - || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) - return NULL; + if (GFC_DESCRIPTOR_TYPE_P (type)) + /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need + to be deallocated if they were allocated. */ + tem = gfc_trans_dealloc_allocated (decl, false, NULL); + else + tem = gfc_call_free (decl); + tem = gfc_omp_unshare_expr (tem); - if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION) - return NULL; + if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause))) + { + stmtblock_t block; + tree then_b; + + gfc_init_block (&block); + gfc_add_expr_to_block (&block, + gfc_walk_alloc_comps (decl, NULL_TREE, + OMP_CLAUSE_DECL (clause), + WALK_ALLOC_COMPS_DTOR)); + gfc_add_expr_to_block (&block, tem); + then_b = gfc_finish_block (&block); + + tem = fold_convert (pvoid_type_node, + GFC_DESCRIPTOR_TYPE_P (type) + ? gfc_conv_descriptor_data_get (decl) : decl); + tem = unshare_expr (tem); + tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem, null_pointer_node); + tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, + then_b, build_empty_stmt (input_location)); + } + return tem; +} - /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need - to be deallocated if they were allocated. */ - return gfc_trans_dealloc_allocated (decl, false, NULL); + +void +gfc_omp_finish_clause (tree c, gimple_seq *pre_p) +{ + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP) + return; + + tree decl = OMP_CLAUSE_DECL (c); + tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE; + if (POINTER_TYPE_P (TREE_TYPE (decl))) + { + if (!gfc_omp_privatize_by_reference (decl) + && !GFC_DECL_GET_SCALAR_POINTER (decl) + && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl) + && !GFC_DECL_CRAY_POINTEE (decl) + && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) + return; + c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (c4) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (c4) = decl; + OMP_CLAUSE_SIZE (c4) = size_int (0); + decl = build_fold_indirect_ref (decl); + OMP_CLAUSE_DECL (c) = decl; + OMP_CLAUSE_SIZE (c) = NULL_TREE; + } + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + stmtblock_t block; + gfc_start_block (&block); + tree type = TREE_TYPE (decl); + tree ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), ptr); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (c) = ptr; + c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (c2) = OMP_CLAUSE_MAP_TO_PSET; + OMP_CLAUSE_DECL (c2) = decl; + OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type); + c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (c3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl); + OMP_CLAUSE_SIZE (c3) = size_int (0); + tree size = create_tmp_var (gfc_array_index_type, NULL); + tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER + || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT) + { + stmtblock_t cond_block; + tree tem, then_b, else_b, zero, cond; + + gfc_init_block (&cond_block); + tem = gfc_full_array_size (&cond_block, decl, + GFC_TYPE_ARRAY_RANK (type)); + gfc_add_modify (&cond_block, size, tem); + gfc_add_modify (&cond_block, size, + fold_build2 (MULT_EXPR, gfc_array_index_type, + size, elemsz)); + then_b = gfc_finish_block (&cond_block); + gfc_init_block (&cond_block); + zero = build_int_cst (gfc_array_index_type, 0); + gfc_add_modify (&cond_block, size, zero); + else_b = gfc_finish_block (&cond_block); + tem = gfc_conv_descriptor_data_get (decl); + tem = fold_convert (pvoid_type_node, tem); + cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tem, null_pointer_node); + gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, + void_type_node, cond, + then_b, else_b)); + } + else + { + gfc_add_modify (&block, size, + gfc_full_array_size (&block, decl, + GFC_TYPE_ARRAY_RANK (type))); + gfc_add_modify (&block, size, + fold_build2 (MULT_EXPR, gfc_array_index_type, + size, elemsz)); + } + OMP_CLAUSE_SIZE (c) = size; + tree stmt = gfc_finish_block (&block); + gimplify_and_add (stmt, pre_p); + } + tree last = c; + if (OMP_CLAUSE_SIZE (c) == NULL_TREE) + OMP_CLAUSE_SIZE (c) + = DECL_P (decl) ? DECL_SIZE_UNIT (decl) + : TYPE_SIZE_UNIT (TREE_TYPE (decl)); + if (c2) + { + OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last); + OMP_CLAUSE_CHAIN (last) = c2; + last = c2; + } + if (c3) + { + OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last); + OMP_CLAUSE_CHAIN (last) = c3; + last = c3; + } + if (c4) + { + OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last); + OMP_CLAUSE_CHAIN (last) = c4; + last = c4; + } } @@ -427,8 +1204,33 @@ gfc_trans_add_clause (tree node, tree tail) } static tree -gfc_trans_omp_variable (gfc_symbol *sym) +gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd) { + if (declare_simd) + { + int cnt = 0; + gfc_symbol *proc_sym; + gfc_formal_arglist *f; + + gcc_assert (sym->attr.dummy); + proc_sym = sym->ns->proc_name; + if (proc_sym->attr.entry_master) + ++cnt; + if (gfc_return_by_reference (proc_sym)) + { + ++cnt; + if (proc_sym->ts.type == BT_CHARACTER) + ++cnt; + } + for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next) + if (f->sym == sym) + break; + else if (f->sym) + ++cnt; + gcc_assert (f); + return build_int_cst (integer_type_node, cnt); + } + tree t = gfc_get_symbol_decl (sym); tree parent_decl; int parent_flag; @@ -442,7 +1244,8 @@ gfc_trans_omp_variable (gfc_symbol *sym) entry_master = sym->attr.result && sym->ns->proc_name->attr.entry_master && !gfc_return_by_reference (sym->ns->proc_name); - parent_decl = DECL_CONTEXT (current_function_decl); + parent_decl = current_function_decl + ? DECL_CONTEXT (current_function_decl) : NULL_TREE; if ((t == parent_decl && return_value) || (sym->ns && sym->ns->proc_name @@ -481,13 +1284,14 @@ gfc_trans_omp_variable (gfc_symbol *sym) } static tree -gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist, - tree list) +gfc_trans_omp_variable_list (enum omp_clause_code code, + gfc_omp_namelist *namelist, tree list, + bool declare_simd) { for (; namelist != NULL; namelist = namelist->next) - if (namelist->sym->attr.referenced) + if (namelist->sym->attr.referenced || declare_simd) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, declare_simd); if (t != error_mark_node) { tree node = build_omp_clause (input_location, code); @@ -498,18 +1302,39 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist, return list; } +struct omp_udr_find_orig_data +{ + gfc_omp_udr *omp_udr; + bool omp_orig_seen; +}; + +static int +omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data) +{ + struct omp_udr_find_orig_data *cd = (struct omp_udr_find_orig_data *) data; + if ((*e)->expr_type == EXPR_VARIABLE + && (*e)->symtree->n.sym == cd->omp_udr->omp_orig) + cd->omp_orig_seen = true; + + return 0; +} + static void -gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) +gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) { + gfc_symbol *sym = n->sym; 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_symbol omp_var_copy[4]; gfc_expr *e1, *e2, *e3, *e4; gfc_ref *ref; tree decl, backend_decl, stmt, type, outer_decl; locus old_loc = gfc_current_locus; const char *iname; bool t; + gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL; decl = OMP_CLAUSE_DECL (c); gfc_current_locus = where; @@ -532,12 +1357,29 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) init_val_sym.attr.referenced = 1; init_val_sym.declared_at = where; init_val_sym.attr.flavor = FL_VARIABLE; - backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym)); + if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK) + backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym)); + else if (udr->initializer_ns) + backend_decl = NULL; + else + switch (sym->ts.type) + { + case BT_LOGICAL: + case BT_INTEGER: + case BT_REAL: + case BT_COMPLEX: + backend_decl = build_zero_cst (gfc_sym_type (&init_val_sym)); + break; + default: + backend_decl = NULL_TREE; + break; + } 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); + if (sym->as) + outer_sym.as = gfc_copy_array_spec (sym->as); outer_sym.attr.dummy = 0; outer_sym.attr.result = 0; outer_sym.attr.flavor = FL_VARIABLE; @@ -558,28 +1400,75 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) symtree3->n.sym = &outer_sym; gcc_assert (symtree3 == root3); + memset (omp_var_copy, 0, sizeof omp_var_copy); + if (udr) + { + omp_var_copy[0] = *udr->omp_out; + omp_var_copy[1] = *udr->omp_in; + *udr->omp_out = outer_sym; + *udr->omp_in = *sym; + if (udr->initializer_ns) + { + omp_var_copy[2] = *udr->omp_priv; + omp_var_copy[3] = *udr->omp_orig; + *udr->omp_priv = *sym; + *udr->omp_orig = outer_sym; + } + } + /* Create expressions. */ e1 = gfc_get_expr (); e1->expr_type = EXPR_VARIABLE; e1->where = where; e1->symtree = symtree1; e1->ts = sym->ts; - e1->ref = ref = gfc_get_ref (); - ref->type = REF_ARRAY; - ref->u.ar.where = where; - ref->u.ar.as = sym->as; - ref->u.ar.type = AR_FULL; - ref->u.ar.dimen = 0; + if (sym->attr.dimension) + { + e1->ref = ref = gfc_get_ref (); + ref->type = REF_ARRAY; + ref->u.ar.where = where; + ref->u.ar.as = sym->as; + ref->u.ar.type = AR_FULL; + ref->u.ar.dimen = 0; + } t = gfc_resolve_expr (e1); gcc_assert (t); - 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); + e2 = NULL; + if (backend_decl != NULL_TREE) + { + 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); + } + else if (udr->initializer_ns == NULL) + { + gcc_assert (sym->ts.type == BT_DERIVED); + e2 = gfc_default_initializer (&sym->ts); + gcc_assert (e2); + t = gfc_resolve_expr (e2); + gcc_assert (t); + } + else if (n->udr->initializer->op == EXEC_ASSIGN) + { + e2 = gfc_copy_expr (n->udr->initializer->expr2); + t = gfc_resolve_expr (e2); + gcc_assert (t); + } + if (udr && udr->initializer_ns) + { + struct omp_udr_find_orig_data cd; + cd.omp_udr = udr; + cd.omp_orig_seen = false; + gfc_code_walker (&n->udr->initializer, + gfc_dummy_code_callback, omp_udr_find_orig, &cd); + if (cd.omp_orig_seen) + OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1; + } e3 = gfc_copy_expr (e1); e3->symtree = symtree3; @@ -587,6 +1476,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) gcc_assert (t); iname = NULL; + e4 = NULL; switch (OMP_CLAUSE_REDUCTION_CODE (c)) { case PLUS_EXPR: @@ -623,6 +1513,18 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) case BIT_XOR_EXPR: iname = "ieor"; break; + case ERROR_MARK: + if (n->udr->combiner->op == EXEC_ASSIGN) + { + gfc_free_expr (e3); + e3 = gfc_copy_expr (n->udr->combiner->expr1); + e4 = gfc_copy_expr (n->udr->combiner->expr2); + t = gfc_resolve_expr (e3); + gcc_assert (t); + t = gfc_resolve_expr (e4); + gcc_assert (t); + } + break; default: gcc_unreachable (); } @@ -646,58 +1548,27 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) 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); + if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK) + { + /* 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); + } /* Create the init statement list. */ pushlevel (); - if (GFC_DESCRIPTOR_TYPE_P (type) - && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) - { - /* If decl is an allocatable array, it needs to be allocated - with the same bounds as the outer var. */ - tree rank, size, esize, ptr; - stmtblock_t block; - - gfc_start_block (&block); - - gfc_add_modify (&block, decl, outer_sym.backend_decl); - rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; - size = gfc_conv_descriptor_ubound_get (decl, rank); - size = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, size, - gfc_conv_descriptor_lbound_get (decl, rank)); - size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - size, gfc_index_one_node); - if (GFC_TYPE_ARRAY_RANK (type) > 1) - size = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, size, - gfc_conv_descriptor_stride_get (decl, rank)); - esize = fold_convert (gfc_array_index_type, - TYPE_SIZE_UNIT (gfc_get_element_type (type))); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, esize); - size = gfc_evaluate_now (fold_convert (size_type_node, size), &block); - - ptr = gfc_create_var (pvoid_type_node, NULL); - gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE); - gfc_conv_descriptor_data_set (&block, decl, ptr); - - gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false, - false)); - stmt = gfc_finish_block (&block); - } - else + if (e2) stmt = gfc_trans_assignment (e1, e2, false, false); + else + stmt = gfc_trans_call (n->udr->initializer, false, + NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -706,22 +1577,11 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) /* Create the merge statement list. */ pushlevel (); - if (GFC_DESCRIPTOR_TYPE_P (type) - && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) - { - /* If decl is an allocatable array, it needs to be deallocated - afterwards. */ - stmtblock_t block; - - gfc_start_block (&block); - gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false, - true)); - gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl, false, - NULL)); - stmt = gfc_finish_block (&block); - } - else + if (e4) stmt = gfc_trans_assignment (e3, e4, false, true); + else + stmt = gfc_trans_call (n->udr->combiner, false, + NULL_TREE, NULL_TREE, false); if (TREE_CODE (stmt) != BIND_EXPR) stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); else @@ -734,32 +1594,91 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where) gfc_current_locus = old_loc; gfc_free_expr (e1); - gfc_free_expr (e2); + if (e2) + gfc_free_expr (e2); gfc_free_expr (e3); - gfc_free_expr (e4); + if (e4) + gfc_free_expr (e4); free (symtree1); free (symtree2); free (symtree3); free (symtree4); - gfc_free_array_spec (outer_sym.as); + if (outer_sym.as) + gfc_free_array_spec (outer_sym.as); + + if (udr) + { + *udr->omp_out = omp_var_copy[0]; + *udr->omp_in = omp_var_copy[1]; + if (udr->initializer_ns) + { + *udr->omp_priv = omp_var_copy[2]; + *udr->omp_orig = omp_var_copy[3]; + } + } } static tree -gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, - enum tree_code reduction_code, locus where) +gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, + locus where) { for (; namelist != NULL; namelist = namelist->next) if (namelist->sym->attr.referenced) { - tree t = gfc_trans_omp_variable (namelist->sym); + tree t = gfc_trans_omp_variable (namelist->sym, false); if (t != error_mark_node) { tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_REDUCTION); OMP_CLAUSE_DECL (node) = t; - OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code; - if (namelist->sym->attr.dimension) - gfc_trans_omp_array_reduction (node, namelist->sym, where); + switch (namelist->u.reduction_op) + { + case OMP_REDUCTION_PLUS: + OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR; + break; + case OMP_REDUCTION_MINUS: + OMP_CLAUSE_REDUCTION_CODE (node) = MINUS_EXPR; + break; + case OMP_REDUCTION_TIMES: + OMP_CLAUSE_REDUCTION_CODE (node) = MULT_EXPR; + break; + case OMP_REDUCTION_AND: + OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ANDIF_EXPR; + break; + case OMP_REDUCTION_OR: + OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ORIF_EXPR; + break; + case OMP_REDUCTION_EQV: + OMP_CLAUSE_REDUCTION_CODE (node) = EQ_EXPR; + break; + case OMP_REDUCTION_NEQV: + OMP_CLAUSE_REDUCTION_CODE (node) = NE_EXPR; + break; + case OMP_REDUCTION_MAX: + OMP_CLAUSE_REDUCTION_CODE (node) = MAX_EXPR; + break; + case OMP_REDUCTION_MIN: + OMP_CLAUSE_REDUCTION_CODE (node) = MIN_EXPR; + break; + case OMP_REDUCTION_IAND: + OMP_CLAUSE_REDUCTION_CODE (node) = BIT_AND_EXPR; + break; + case OMP_REDUCTION_IOR: + OMP_CLAUSE_REDUCTION_CODE (node) = BIT_IOR_EXPR; + break; + case OMP_REDUCTION_IEOR: + OMP_CLAUSE_REDUCTION_CODE (node) = BIT_XOR_EXPR; + break; + case OMP_REDUCTION_USER: + OMP_CLAUSE_REDUCTION_CODE (node) = ERROR_MARK; + break; + default: + gcc_unreachable (); + } + if (namelist->sym->attr.dimension + || namelist->u.reduction_op == OMP_REDUCTION_USER + || namelist->sym->attr.allocatable) + gfc_trans_omp_array_reduction_or_udr (node, namelist, where); list = gfc_trans_add_clause (node, list); } } @@ -768,7 +1687,7 @@ gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, - locus where) + locus where, bool declare_simd = false) { tree omp_clauses = NULL_TREE, chunk_size, c; int list; @@ -780,62 +1699,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, for (list = 0; list < OMP_LIST_NUM; list++) { - gfc_namelist *n = clauses->lists[list]; + gfc_omp_namelist *n = clauses->lists[list]; if (n == NULL) continue; - if (list >= OMP_LIST_REDUCTION_FIRST - && list <= OMP_LIST_REDUCTION_LAST) - { - enum tree_code reduction_code; - switch (list) - { - case OMP_LIST_PLUS: - reduction_code = PLUS_EXPR; - break; - case OMP_LIST_MULT: - reduction_code = MULT_EXPR; - break; - case OMP_LIST_SUB: - reduction_code = MINUS_EXPR; - break; - case OMP_LIST_AND: - reduction_code = TRUTH_ANDIF_EXPR; - break; - case OMP_LIST_OR: - reduction_code = TRUTH_ORIF_EXPR; - break; - case OMP_LIST_EQV: - reduction_code = EQ_EXPR; - break; - case OMP_LIST_NEQV: - reduction_code = NE_EXPR; - break; - case OMP_LIST_MAX: - reduction_code = MAX_EXPR; - break; - case OMP_LIST_MIN: - reduction_code = MIN_EXPR; - break; - case OMP_LIST_IAND: - reduction_code = BIT_AND_EXPR; - break; - case OMP_LIST_IOR: - reduction_code = BIT_IOR_EXPR; - break; - case OMP_LIST_IEOR: - reduction_code = BIT_XOR_EXPR; - break; - default: - gcc_unreachable (); - } - omp_clauses - = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code, - where); - continue; - } switch (list) { + case OMP_LIST_REDUCTION: + omp_clauses = gfc_trans_omp_reduction_list (n, omp_clauses, where); + break; case OMP_LIST_PRIVATE: clause_code = OMP_CLAUSE_PRIVATE; goto add_clause; @@ -853,10 +1725,411 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, goto add_clause; case OMP_LIST_COPYPRIVATE: clause_code = OMP_CLAUSE_COPYPRIVATE; + goto add_clause; + case OMP_LIST_UNIFORM: + clause_code = OMP_CLAUSE_UNIFORM; /* FALLTHROUGH */ add_clause: omp_clauses - = gfc_trans_omp_variable_list (clause_code, n, omp_clauses); + = gfc_trans_omp_variable_list (clause_code, n, omp_clauses, + declare_simd); + break; + case OMP_LIST_ALIGNED: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALIGNED); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree alignment_var; + + if (block == NULL) + alignment_var = gfc_conv_constant_to_tree (n->expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + alignment_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; + case OMP_LIST_LINEAR: + { + gfc_expr *last_step_expr = NULL; + tree last_step = NULL_TREE; + + for (; n != NULL; n = n->next) + { + if (n->expr) + { + last_step_expr = n->expr; + last_step = NULL_TREE; + } + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_LINEAR); + OMP_CLAUSE_DECL (node) = t; + if (last_step_expr && last_step == NULL_TREE) + { + if (block == NULL) + last_step + = gfc_conv_constant_to_tree (last_step_expr); + else + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, last_step_expr); + gfc_add_block_to_block (block, &se.pre); + last_step = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } + } + OMP_CLAUSE_LINEAR_STEP (node) + = fold_convert (gfc_typenode_for_spec (&n->sym->ts), + last_step); + if (n->sym->attr.dimension || n->sym->attr.allocatable) + OMP_CLAUSE_LINEAR_ARRAY (node) = 1; + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + } + } + break; + case OMP_LIST_DEPEND: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND); + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + tree decl = gfc_get_symbol_decl (n->sym); + if (gfc_omp_privatize_by_reference (decl)) + decl = build_fold_indirect_ref (decl); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + decl = gfc_conv_descriptor_data_get (decl); + decl = fold_convert (build_pointer_type (char_type_node), + decl); + decl = build_fold_indirect_ref (decl); + } + else if (DECL_P (decl)) + TREE_ADDRESSABLE (decl) = 1; + OMP_CLAUSE_DECL (node) = decl; + } + else + { + tree ptr; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + ptr = se.expr; + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + } + gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + } + switch (n->u.depend_op) + { + case OMP_DEPEND_IN: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN; + break; + case OMP_DEPEND_OUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT; + break; + case OMP_DEPEND_INOUT: + OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + break; + case OMP_LIST_MAP: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); + tree node2 = NULL_TREE; + tree node3 = NULL_TREE; + tree node4 = NULL_TREE; + tree decl = gfc_get_symbol_decl (n->sym); + if (DECL_P (decl)) + TREE_ADDRESSABLE (decl) = 1; + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + if (POINTER_TYPE_P (TREE_TYPE (decl))) + { + node4 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node4) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node4) = decl; + OMP_CLAUSE_SIZE (node4) = size_int (0); + decl = build_fold_indirect_ref (decl); + } + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + tree ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (node) = ptr; + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node2) = OMP_CLAUSE_MAP_TO_PSET; + OMP_CLAUSE_DECL (node2) = decl; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node3) + = gfc_conv_descriptor_data_get (decl); + OMP_CLAUSE_SIZE (node3) = size_int (0); + if (n->sym->attr.pointer) + { + stmtblock_t cond_block; + tree size + = gfc_create_var (gfc_array_index_type, NULL); + tree tem, then_b, else_b, zero, cond; + + gfc_init_block (&cond_block); + tem + = gfc_full_array_size (&cond_block, decl, + GFC_TYPE_ARRAY_RANK (type)); + gfc_add_modify (&cond_block, size, tem); + then_b = gfc_finish_block (&cond_block); + gfc_init_block (&cond_block); + zero = build_int_cst (gfc_array_index_type, 0); + gfc_add_modify (&cond_block, size, zero); + else_b = gfc_finish_block (&cond_block); + tem = gfc_conv_descriptor_data_get (decl); + tem = fold_convert (pvoid_type_node, tem); + cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, + tem, null_pointer_node); + gfc_add_expr_to_block (block, + build3_loc (input_location, + COND_EXPR, + void_type_node, + cond, then_b, + else_b)); + OMP_CLAUSE_SIZE (node) = size; + } + else + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, decl, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + else + OMP_CLAUSE_DECL (node) = decl; + } + else + { + tree ptr, ptr2; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + gfc_add_block_to_block (block, &se.pre); + ptr = se.expr; + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (ptr)); + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + tree type = TREE_TYPE (se.expr); + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, se.expr, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + + if (POINTER_TYPE_P (TREE_TYPE (decl)) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) + { + node4 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node4) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node4) = decl; + OMP_CLAUSE_SIZE (node4) = size_int (0); + decl = build_fold_indirect_ref (decl); + } + ptr = fold_convert (sizetype, ptr); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + ptr2 = gfc_conv_descriptor_data_get (decl); + node2 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node2) = OMP_CLAUSE_MAP_TO_PSET; + OMP_CLAUSE_DECL (node2) = decl; + OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type); + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node3) + = gfc_conv_descriptor_data_get (decl); + } + else + { + if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) + ptr2 = build_fold_addr_expr (decl); + else + { + gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl))); + ptr2 = decl; + } + node3 = build_omp_clause (input_location, + OMP_CLAUSE_MAP); + OMP_CLAUSE_MAP_KIND (node3) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_DECL (node3) = decl; + } + ptr2 = fold_convert (sizetype, ptr2); + OMP_CLAUSE_SIZE (node3) + = fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2); + } + switch (n->u.map_op) + { + case OMP_MAP_ALLOC: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_ALLOC; + break; + case OMP_MAP_TO: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TO; + break; + case OMP_MAP_FROM: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_FROM; + break; + case OMP_MAP_TOFROM: + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_TOFROM; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + if (node2) + omp_clauses = gfc_trans_add_clause (node2, omp_clauses); + if (node3) + omp_clauses = gfc_trans_add_clause (node3, omp_clauses); + if (node4) + omp_clauses = gfc_trans_add_clause (node4, omp_clauses); + } + break; + case OMP_LIST_TO: + case OMP_LIST_FROM: + for (; n != NULL; n = n->next) + { + if (!n->sym->attr.referenced) + continue; + + tree node = build_omp_clause (input_location, + list == OMP_LIST_TO + ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM); + if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL) + { + tree decl = gfc_get_symbol_decl (n->sym); + if (gfc_omp_privatize_by_reference (decl)) + decl = build_fold_indirect_ref (decl); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) + { + tree type = TREE_TYPE (decl); + tree ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + ptr = build_fold_indirect_ref (ptr); + OMP_CLAUSE_DECL (node) = ptr; + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, decl, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + else + OMP_CLAUSE_DECL (node) = decl; + } + else + { + tree ptr; + gfc_init_se (&se, NULL); + if (n->expr->ref->u.ar.type == AR_ELEMENT) + { + gfc_conv_expr_reference (&se, n->expr); + ptr = se.expr; + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (ptr)); + } + else + { + gfc_conv_expr_descriptor (&se, n->expr); + ptr = gfc_conv_array_data (se.expr); + tree type = TREE_TYPE (se.expr); + gfc_add_block_to_block (block, &se.pre); + OMP_CLAUSE_SIZE (node) + = gfc_full_array_size (block, se.expr, + GFC_TYPE_ARRAY_RANK (type)); + tree elemsz + = TYPE_SIZE_UNIT (gfc_get_element_type (type)); + elemsz = fold_convert (gfc_array_index_type, elemsz); + OMP_CLAUSE_SIZE (node) + = fold_build2 (MULT_EXPR, gfc_array_index_type, + OMP_CLAUSE_SIZE (node), elemsz); + } + gfc_add_block_to_block (block, &se.post); + ptr = fold_convert (build_pointer_type (char_type_node), + ptr); + OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } break; default: break; @@ -1000,7 +2273,146 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } - return omp_clauses; + if (clauses->inbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_INBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->notinbranch) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOTINBRANCH); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + switch (clauses->cancel) + { + case OMP_CANCEL_UNKNOWN: + break; + case OMP_CANCEL_PARALLEL: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PARALLEL); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_SECTIONS: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SECTIONS); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_DO: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_FOR); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + case OMP_CANCEL_TASKGROUP: + c = build_omp_clause (where.lb->location, OMP_CLAUSE_TASKGROUP); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + break; + } + + if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_PROC_BIND); + switch (clauses->proc_bind) + { + case OMP_PROC_BIND_MASTER: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER; + break; + case OMP_PROC_BIND_SPREAD: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD; + break; + case OMP_PROC_BIND_CLOSE: + OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE; + break; + default: + gcc_unreachable (); + } + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->safelen_expr) + { + tree safelen_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->safelen_expr); + gfc_add_block_to_block (block, &se.pre); + safelen_var = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SAFELEN); + OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->simdlen_expr) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_expr); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->num_teams) + { + tree num_teams; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_teams); + gfc_add_block_to_block (block, &se.pre); + num_teams = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_TEAMS); + OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->device) + { + tree device; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->device); + gfc_add_block_to_block (block, &se.pre); + device = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEVICE); + OMP_CLAUSE_DEVICE_ID (c) = device; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + if (clauses->thread_limit) + { + tree thread_limit; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->thread_limit); + gfc_add_block_to_block (block, &se.pre); + thread_limit = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (where.lb->location, OMP_CLAUSE_THREAD_LIMIT); + OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + chunk_size = NULL_TREE; + if (clauses->dist_chunk_size) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->dist_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->dist_sched_kind != OMP_SCHED_NONE) + { + c = build_omp_clause (where.lb->location, OMP_CLAUSE_DIST_SCHEDULE); + OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + + return nreverse (omp_clauses); } /* Like gfc_trans_code, but force creation of a BIND_EXPR around it. */ @@ -1045,6 +2457,7 @@ gfc_trans_omp_atomic (gfc_code *code) enum tree_code op = ERROR_MARK; enum tree_code aop = OMP_ATOMIC; bool var_on_left = false; + bool seq_cst = (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) != 0; code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); @@ -1060,7 +2473,7 @@ gfc_trans_omp_atomic (gfc_code *code) && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; - switch (atomic_code->ext.omp_atomic) + switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) { case GFC_OMP_ATOMIC_READ: gfc_conv_expr (&vse, code->expr1); @@ -1072,6 +2485,7 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = gfc_build_addr_expr (NULL, lse.expr); x = build1 (OMP_ATOMIC_READ, type, lhsaddr); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); @@ -1107,7 +2521,9 @@ gfc_trans_omp_atomic (gfc_code *code) type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) { gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &rse.pre); @@ -1229,7 +2645,9 @@ gfc_trans_omp_atomic (gfc_code *code) lhsaddr = save_expr (lhsaddr); rhs = gfc_evaluate_now (rse.expr, &block); - if (atomic_code->ext.omp_atomic == GFC_OMP_ATOMIC_WRITE) + if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_WRITE) + || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) x = rhs; else { @@ -1252,6 +2670,7 @@ gfc_trans_omp_atomic (gfc_code *code) if (aop == OMP_ATOMIC) { x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; gfc_add_expr_to_block (&block, x); } else @@ -1273,6 +2692,7 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_add_block_to_block (&block, &lse.pre); } x = build2 (aop, type, lhsaddr, convert (type, x)); + OMP_ATOMIC_SEQ_CST (x) = seq_cst; x = convert (TREE_TYPE (vse.expr), x); gfc_add_modify (&block, vse.expr, x); } @@ -1288,6 +2708,63 @@ gfc_trans_omp_barrier (void) } static tree +gfc_trans_omp_cancel (gfc_code *code) +{ + int mask = 0; + tree ifc = boolean_true_node; + stmtblock_t block; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + gfc_start_block (&block); + if (code->ext.omp_clauses->if_expr) + { + gfc_se se; + tree if_var; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, code->ext.omp_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); + tree type = TREE_TYPE (if_var); + ifc = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, if_var, + build_zero_cst (type)); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL); + tree c_bool_type = TREE_TYPE (TREE_TYPE (decl)); + ifc = fold_convert (c_bool_type, ifc); + gfc_add_expr_to_block (&block, + build_call_expr_loc (input_location, decl, 2, + build_int_cst (integer_type_node, + mask), ifc)); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_cancellation_point (gfc_code *code) +{ + int mask = 0; + switch (code->ext.omp_clauses->cancel) + { + case OMP_CANCEL_PARALLEL: mask = 1; break; + case OMP_CANCEL_DO: mask = 2; break; + case OMP_CANCEL_SECTIONS: mask = 4; break; + case OMP_CANCEL_TASKGROUP: mask = 8; break; + default: gcc_unreachable (); + } + tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT); + return build_call_expr_loc (input_location, decl, 1, + build_int_cst (integer_type_node, mask)); +} + +static tree gfc_trans_omp_critical (gfc_code *code) { tree name = NULL_TREE, stmt; @@ -1304,7 +2781,7 @@ typedef struct dovar_init_d { static tree -gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, +gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, gfc_omp_clauses *do_clauses, tree par_clauses) { gfc_se se; @@ -1344,14 +2821,16 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, 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; + gfc_omp_namelist *n = NULL; + if (op != EXEC_OMP_DISTRIBUTE) + for (n = clauses->lists[(op == EXEC_OMP_SIMD && collapse == 1) + ? OMP_LIST_LINEAR : OMP_LIST_LASTPRIVATE]; + n != NULL; n = n->next) + if (code->ext.iterator->var->symtree->n.sym == n->sym) + break; if (n != NULL) dovar_found = 1; - else if (n == NULL) + else if (n == NULL && op != EXEC_OMP_SIMD) for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next) if (code->ext.iterator->var->symtree->n.sym == n->sym) break; @@ -1393,7 +2872,8 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } else dovar_decl - = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym); + = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym, + false); /* Loop body. */ if (simple) @@ -1447,11 +2927,24 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, if (!dovar_found) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op == EXEC_OMP_SIMD) + { + if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); + if (!simple) + dovar_found = 2; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = dovar_decl; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } - else if (dovar_found == 2) + if (dovar_found == 2) { tree c = NULL; @@ -1475,8 +2968,14 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp; break; } + else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR + && OMP_CLAUSE_DECL (c) == dovar_decl) + { + OMP_CLAUSE_LINEAR_STMT (c) = tmp; + break; + } } - if (c == NULL && par_clauses != NULL) + if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL) { for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c)) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE @@ -1496,7 +2995,17 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } if (!simple) { - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (op != EXEC_OMP_SIMD) + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + else if (collapse == 1) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1; + OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1; + } + else + tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); OMP_CLAUSE_DECL (tmp) = count; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } @@ -1538,7 +3047,13 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock, } /* End of loop body. */ - stmt = make_node (OMP_FOR); + switch (op) + { + case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break; + case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break; + case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break; + default: gcc_unreachable (); + } TREE_TYPE (stmt) = void_type_node; OMP_FOR_BODY (stmt) = gfc_finish_block (&body); @@ -1589,41 +3104,352 @@ gfc_trans_omp_parallel (gfc_code *code) return gfc_finish_block (&block); } +enum +{ + GFC_OMP_SPLIT_SIMD, + GFC_OMP_SPLIT_DO, + GFC_OMP_SPLIT_PARALLEL, + GFC_OMP_SPLIT_DISTRIBUTE, + GFC_OMP_SPLIT_TEAMS, + GFC_OMP_SPLIT_TARGET, + GFC_OMP_SPLIT_NUM +}; + +enum +{ + GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD), + GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO), + GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL), + GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE), + GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS), + GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET) +}; + +static void +gfc_split_omp_clauses (gfc_code *code, + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]) +{ + int mask = 0, innermost = 0; + memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses)); + switch (code->op) + { + case EXEC_OMP_DISTRIBUTE: + innermost = GFC_OMP_SPLIT_DISTRIBUTE; + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL + | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_DISTRIBUTE_SIMD: + mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_DO: + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_DO_SIMD: + mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_PARALLEL: + innermost = GFC_OMP_SPLIT_PARALLEL; + break; + case EXEC_OMP_PARALLEL_DO: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_SIMD: + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TARGET: + innermost = GFC_OMP_SPLIT_TARGET; + break; + case EXEC_OMP_TARGET_TEAMS: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS; + innermost = GFC_OMP_SPLIT_TEAMS; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS + | GFC_OMP_MASK_DISTRIBUTE; + innermost = GFC_OMP_SPLIT_DISTRIBUTE; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS + | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TEAMS: + innermost = GFC_OMP_SPLIT_TEAMS; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE; + innermost = GFC_OMP_SPLIT_DISTRIBUTE; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO; + innermost = GFC_OMP_SPLIT_DO; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE + | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD; + innermost = GFC_OMP_SPLIT_SIMD; + break; + default: + gcc_unreachable (); + } + if (mask == 0) + { + clausesa[innermost] = *code->ext.omp_clauses; + return; + } + if (code->ext.omp_clauses != NULL) + { + if (mask & GFC_OMP_MASK_TARGET) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] + = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].device + = code->ext.omp_clauses->device; + } + if (mask & GFC_OMP_MASK_TEAMS) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + = code->ext.omp_clauses->num_teams; + clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit + = code->ext.omp_clauses->thread_limit; + /* Shared and default clauses are allowed on parallel and teams. */ + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing + = code->ext.omp_clauses->default_sharing; + } + if (mask & GFC_OMP_MASK_DISTRIBUTE) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_sched_kind + = code->ext.omp_clauses->dist_sched_kind; + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_chunk_size + = code->ext.omp_clauses->dist_chunk_size; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse + = code->ext.omp_clauses->collapse; + } + if (mask & GFC_OMP_MASK_PARALLEL) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN] + = code->ext.omp_clauses->lists[OMP_LIST_COPYIN]; + clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads + = code->ext.omp_clauses->num_threads; + clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind + = code->ext.omp_clauses->proc_bind; + /* Shared and default clauses are allowed on parallel and teams. */ + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED] + = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; + clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing + = code->ext.omp_clauses->default_sharing; + } + if (mask & GFC_OMP_MASK_DO) + { + /* First the clauses that are unique to some constructs. */ + clausesa[GFC_OMP_SPLIT_DO].ordered + = code->ext.omp_clauses->ordered; + clausesa[GFC_OMP_SPLIT_DO].sched_kind + = code->ext.omp_clauses->sched_kind; + clausesa[GFC_OMP_SPLIT_DO].chunk_size + = code->ext.omp_clauses->chunk_size; + clausesa[GFC_OMP_SPLIT_DO].nowait + = code->ext.omp_clauses->nowait; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_DO].collapse + = code->ext.omp_clauses->collapse; + } + if (mask & GFC_OMP_MASK_SIMD) + { + clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr + = code->ext.omp_clauses->safelen_expr; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LINEAR] + = code->ext.omp_clauses->lists[OMP_LIST_LINEAR]; + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED] + = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; + /* Duplicate collapse. */ + clausesa[GFC_OMP_SPLIT_SIMD].collapse + = code->ext.omp_clauses->collapse; + } + /* Private clause is supported on all constructs but target, + it is enough to put it on the innermost one. For + !$ omp do put it on parallel though, + as that's what we did for OpenMP 3.1. */ + clausesa[innermost == GFC_OMP_SPLIT_DO + ? (int) GFC_OMP_SPLIT_PARALLEL + : innermost].lists[OMP_LIST_PRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE]; + /* Firstprivate clause is supported on all constructs but + target and simd. Put it on the outermost of those and + duplicate on parallel. */ + if (mask & GFC_OMP_MASK_TEAMS) + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + else if (mask & GFC_OMP_MASK_DISTRIBUTE) + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; + /* Lastprivate is allowed on do and simd. In + parallel do{, simd} we actually want to put it on + parallel rather than do. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE] + = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE]; + /* Reduction is allowed on simd, do, parallel and teams. + Duplicate it on all of them, but omit on do if + parallel is present. */ + if (mask & GFC_OMP_MASK_TEAMS) + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + else if (mask & GFC_OMP_MASK_DO) + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + if (mask & GFC_OMP_MASK_SIMD) + clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_REDUCTION] + = code->ext.omp_clauses->lists[OMP_LIST_REDUCTION]; + /* FIXME: This is currently being discussed. */ + if (mask & GFC_OMP_MASK_PARALLEL) + clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr + = code->ext.omp_clauses->if_expr; + else + clausesa[GFC_OMP_SPLIT_TARGET].if_expr + = code->ext.omp_clauses->if_expr; + } + if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) + clausesa[GFC_OMP_SPLIT_DO].nowait = true; +} + static tree -gfc_trans_omp_parallel_do (gfc_code *code) +gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock, + gfc_omp_clauses *clausesa, tree omp_clauses) { - stmtblock_t block, *pblock = NULL; - gfc_omp_clauses parallel_clauses, do_clauses; - tree stmt, omp_clauses = NULL_TREE; + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, body, omp_do_clauses = NULL_TREE; - gfc_start_block (&block); + if (pblock == NULL) + gfc_start_block (&block); + else + gfc_init_block (&block); - memset (&do_clauses, 0, sizeof (do_clauses)); - if (code->ext.omp_clauses != NULL) + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_do_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc); + body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock ? pblock : &block, + &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses); + if (pblock == NULL) + { + if (TREE_CODE (body) != BIND_EXPR) + body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0)); + else + poplevel (0, 0); + } + else if (TREE_CODE (body) != BIND_EXPR) + body = build3_v (BIND_EXPR, NULL, body, NULL_TREE); + if (gfc_option.gfc_flag_openmp) { - memcpy (¶llel_clauses, code->ext.omp_clauses, - sizeof (parallel_clauses)); - do_clauses.sched_kind = parallel_clauses.sched_kind; - do_clauses.chunk_size = parallel_clauses.chunk_size; - do_clauses.ordered = parallel_clauses.ordered; - do_clauses.collapse = parallel_clauses.collapse; - parallel_clauses.sched_kind = OMP_SCHED_NONE; - parallel_clauses.chunk_size = NULL; - parallel_clauses.ordered = false; - parallel_clauses.collapse = 0; - omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses, - code->loc); - } - do_clauses.nowait = true; - if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC) - pblock = █ + stmt = make_node (OMP_FOR); + TREE_TYPE (stmt) = void_type_node; + OMP_FOR_BODY (stmt) = body; + OMP_FOR_CLAUSES (stmt) = omp_do_clauses; + } else - pushlevel (); - stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses); - if (TREE_CODE (stmt) != BIND_EXPR) - stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + stmt = body; + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock, + gfc_omp_clauses *clausesa) +{ + stmtblock_t block, *new_pblock = pblock; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + if (pblock == NULL) + gfc_start_block (&block); else - poplevel (0, 0); + gfc_init_block (&block); + + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + if (pblock == NULL) + { + if (!clausesa[GFC_OMP_SPLIT_DO].ordered + && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC) + new_pblock = █ + else + pushlevel (); + } + stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock, + &clausesa[GFC_OMP_SPLIT_DO], omp_clauses); + if (pblock == NULL) + { + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + else if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE); stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, omp_clauses); OMP_PARALLEL_COMBINED (stmt) = 1; @@ -1632,6 +3458,50 @@ gfc_trans_omp_parallel_do (gfc_code *code) } static tree +gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock, + gfc_omp_clauses *clausesa) +{ + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + if (pblock == NULL) + gfc_start_block (&block); + else + gfc_init_block (&block); + + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL], + code->loc); + if (pblock == NULL) + pushlevel (); + stmt = gfc_trans_omp_do_simd (code, pblock, clausesa, omp_clauses); + if (pblock == NULL) + { + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + } + else if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE); + if (gfc_option.gfc_flag_openmp) + { + stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt, + omp_clauses); + OMP_PARALLEL_COMBINED (stmt) = 1; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_parallel_sections (gfc_code *code) { stmtblock_t block; @@ -1743,6 +3613,13 @@ gfc_trans_omp_task (gfc_code *code) } static tree +gfc_trans_omp_taskgroup (gfc_code *code) +{ + tree stmt = gfc_trans_code (code->block->next); + return build1_loc (input_location, OMP_TASKGROUP, void_type_node, stmt); +} + +static tree gfc_trans_omp_taskwait (void) { tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT); @@ -1757,6 +3634,170 @@ gfc_trans_omp_taskyield (void) } static tree +gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa) +{ + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE], + code->loc); + switch (code->op) + { + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE: + /* This is handled in gfc_trans_omp_do. */ + gcc_unreachable (); + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + stmt = gfc_trans_omp_parallel_do (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + stmt = gfc_trans_omp_parallel_do_simd (code, &block, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + case EXEC_OMP_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block, + &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0)); + else + poplevel (0, 0); + break; + default: + gcc_unreachable (); + } + if (gfc_option.gfc_flag_openmp) + { + tree distribute = make_node (OMP_DISTRIBUTE); + TREE_TYPE (distribute) = void_type_node; + OMP_FOR_BODY (distribute) = stmt; + OMP_FOR_CLAUSES (distribute) = omp_clauses; + stmt = distribute; + } + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa) +{ + stmtblock_t block; + gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + if (clausesa == NULL) + { + clausesa = clausesa_buf; + gfc_split_omp_clauses (code, clausesa); + } + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TEAMS], + code->loc); + switch (code->op) + { + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TEAMS: + stmt = gfc_trans_omp_code (code->block->next, true); + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE: + stmt = gfc_trans_omp_do (code, EXEC_OMP_DISTRIBUTE, NULL, + &clausesa[GFC_OMP_SPLIT_DISTRIBUTE], + NULL); + break; + default: + stmt = gfc_trans_omp_distribute (code, clausesa); + break; + } + stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target (gfc_code *code) +{ + stmtblock_t block; + gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM]; + tree stmt, omp_clauses = NULL_TREE; + + gfc_start_block (&block); + gfc_split_omp_clauses (code, clausesa); + if (gfc_option.gfc_flag_openmp) + omp_clauses + = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET], + code->loc); + if (code->op == EXEC_OMP_TARGET) + stmt = gfc_trans_omp_code (code->block->next, true); + else + stmt = gfc_trans_omp_teams (code, clausesa); + if (TREE_CODE (stmt) != BIND_EXPR) + stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE); + if (gfc_option.gfc_flag_openmp) + stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target_data (gfc_code *code) +{ + stmtblock_t block; + tree stmt, omp_clauses; + + gfc_start_block (&block); + omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, + code->loc); + stmt = gfc_trans_omp_code (code->block->next, true); + stmt = build2_loc (input_location, OMP_TARGET_DATA, void_type_node, stmt, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree +gfc_trans_omp_target_update (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 = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node, + omp_clauses); + gfc_add_expr_to_block (&block, stmt); + return gfc_finish_block (&block); +} + +static tree gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) { tree res, tmp, stmt; @@ -1923,10 +3964,23 @@ gfc_trans_omp_directive (gfc_code *code) return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: return gfc_trans_omp_barrier (); + case EXEC_OMP_CANCEL: + return gfc_trans_omp_cancel (code); + case EXEC_OMP_CANCELLATION_POINT: + return gfc_trans_omp_cancellation_point (code); case EXEC_OMP_CRITICAL: return gfc_trans_omp_critical (code); + case EXEC_OMP_DISTRIBUTE: case EXEC_OMP_DO: - return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL); + case EXEC_OMP_SIMD: + return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses, + NULL); + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: + return gfc_trans_omp_distribute (code, NULL); + case EXEC_OMP_DO_SIMD: + return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE); case EXEC_OMP_FLUSH: return gfc_trans_omp_flush (); case EXEC_OMP_MASTER: @@ -1936,7 +3990,9 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_PARALLEL: return gfc_trans_omp_parallel (code); case EXEC_OMP_PARALLEL_DO: - return gfc_trans_omp_parallel_do (code); + return gfc_trans_omp_parallel_do (code, NULL, NULL); + case EXEC_OMP_PARALLEL_DO_SIMD: + return gfc_trans_omp_parallel_do_simd (code, NULL, NULL); case EXEC_OMP_PARALLEL_SECTIONS: return gfc_trans_omp_parallel_sections (code); case EXEC_OMP_PARALLEL_WORKSHARE: @@ -1945,15 +4001,53 @@ gfc_trans_omp_directive (gfc_code *code) 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_TARGET: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + return gfc_trans_omp_target (code); + case EXEC_OMP_TARGET_DATA: + return gfc_trans_omp_target_data (code); + case EXEC_OMP_TARGET_UPDATE: + return gfc_trans_omp_target_update (code); case EXEC_OMP_TASK: return gfc_trans_omp_task (code); + case EXEC_OMP_TASKGROUP: + return gfc_trans_omp_taskgroup (code); case EXEC_OMP_TASKWAIT: return gfc_trans_omp_taskwait (); case EXEC_OMP_TASKYIELD: return gfc_trans_omp_taskyield (); + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + return gfc_trans_omp_teams (code, NULL); case EXEC_OMP_WORKSHARE: return gfc_trans_omp_workshare (code, code->ext.omp_clauses); default: gcc_unreachable (); } } + +void +gfc_trans_omp_declare_simd (gfc_namespace *ns) +{ + if (ns->entries) + return; + + gfc_omp_declare_simd *ods; + for (ods = ns->omp_declare_simd; ods; ods = ods->next) + { + tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true); + tree fndecl = ns->proc_name->backend_decl; + if (c != NULL_TREE) + c = tree_cons (NULL_TREE, c, NULL_TREE); + c = build_tree_list (get_identifier ("omp declare simd"), c); + TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl); + DECL_ATTRIBUTES (fndecl) = c; + } +} diff --git a/gcc-4.9/gcc/fortran/trans-stmt.c b/gcc-4.9/gcc/fortran/trans-stmt.c index 00c99fcfb..6d2db5ef7 100644 --- a/gcc-4.9/gcc/fortran/trans-stmt.c +++ b/gcc-4.9/gcc/fortran/trans-stmt.c @@ -1164,13 +1164,16 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) { gfc_se se; tree desc; + bool cst_array_ctor; desc = sym->backend_decl; + cst_array_ctor = e->expr_type == EXPR_ARRAY + && gfc_constant_array_constructor_p (e->value.constructor); /* If association is to an expression, evaluate it and create temporary. Otherwise, get descriptor of target for pointer assignment. */ gfc_init_se (&se, NULL); - if (sym->assoc->variable || e->expr_type == EXPR_ARRAY) + if (sym->assoc->variable || cst_array_ctor) { se.direct_byref = 1; se.use_offset = 1; @@ -1181,7 +1184,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) /* If we didn't already do the pointer assignment, set associate-name descriptor to the one generated for the temporary. */ - if (!sym->assoc->variable && e->expr_type != EXPR_ARRAY) + if (!sym->assoc->variable && !cst_array_ctor) { int dim; diff --git a/gcc-4.9/gcc/fortran/trans-stmt.h b/gcc-4.9/gcc/fortran/trans-stmt.h index 8a57be4d5..087bafea4 100644 --- a/gcc-4.9/gcc/fortran/trans-stmt.h +++ b/gcc-4.9/gcc/fortran/trans-stmt.h @@ -63,6 +63,7 @@ tree gfc_trans_deallocate_array (tree); /* trans-openmp.c */ tree gfc_trans_omp_directive (gfc_code *); +void gfc_trans_omp_declare_simd (gfc_namespace *); /* trans-io.c */ tree gfc_trans_open (gfc_code *); diff --git a/gcc-4.9/gcc/fortran/trans-types.c b/gcc-4.9/gcc/fortran/trans-types.c index 59637f2d3..22f456e02 100644 --- a/gcc-4.9/gcc/fortran/trans-types.c +++ b/gcc-4.9/gcc/fortran/trans-types.c @@ -2162,9 +2162,6 @@ gfc_sym_type (gfc_symbol * sym) restricted); byref = 0; } - - if (sym->attr.cray_pointee) - GFC_POINTER_TYPE_P (type) = 1; } else { @@ -2183,8 +2180,6 @@ gfc_sym_type (gfc_symbol * sym) if (sym->attr.allocatable || sym->attr.pointer || gfc_is_associate_pointer (sym)) type = gfc_build_pointer_type (sym, type); - if (sym->attr.pointer || sym->attr.cray_pointee) - GFC_POINTER_TYPE_P (type) = 1; } /* We currently pass all parameters by reference. @@ -2554,6 +2549,8 @@ gfc_get_derived_type (gfc_symbol * derived) else if (derived->declared_at.lb) gfc_set_decl_location (field, &derived->declared_at); + gfc_finish_decl_attrs (field, &c->attr); + DECL_PACKED (field) |= TYPE_PACKED (typenode); gcc_assert (field); diff --git a/gcc-4.9/gcc/fortran/trans.c b/gcc-4.9/gcc/fortran/trans.c index 5961c267e..7c73f5961 100644 --- a/gcc-4.9/gcc/fortran/trans.c +++ b/gcc-4.9/gcc/fortran/trans.c @@ -1848,20 +1848,43 @@ trans_code (gfc_code * code, tree cond) case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: + case EXEC_OMP_CANCEL: + case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: + case EXEC_OMP_DISTRIBUTE: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: case EXEC_OMP_DO: + case EXEC_OMP_DO_SIMD: 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_DO_SIMD: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: case EXEC_OMP_SECTIONS: + case EXEC_OMP_SIMD: case EXEC_OMP_SINGLE: + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + case EXEC_OMP_TARGET_TEAMS: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_UPDATE: case EXEC_OMP_TASK: + case EXEC_OMP_TASKGROUP: case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: + case EXEC_OMP_TEAMS: + case EXEC_OMP_TEAMS_DISTRIBUTE: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_WORKSHARE: res = gfc_trans_omp_directive (code); break; diff --git a/gcc-4.9/gcc/fortran/trans.h b/gcc-4.9/gcc/fortran/trans.h index 7809bb05b..b55460f4d 100644 --- a/gcc-4.9/gcc/fortran/trans.h +++ b/gcc-4.9/gcc/fortran/trans.h @@ -547,6 +547,9 @@ void gfc_set_decl_assembler_name (tree, tree); /* Returns true if a variable of specified size should go on the stack. */ int gfc_can_put_var_on_stack (tree); +/* Set GFC_DECL_SCALAR_* on decl from sym if needed. */ +void gfc_finish_decl_attrs (tree, symbol_attribute *); + /* Allocate the lang-specific part of a decl node. */ void gfc_allocate_lang_decl (tree); @@ -666,7 +669,9 @@ tree gfc_omp_report_decl (tree); tree gfc_omp_clause_default_ctor (tree, tree, tree); tree gfc_omp_clause_copy_ctor (tree, tree, tree); tree gfc_omp_clause_assign_op (tree, tree, tree); +tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); +void gfc_omp_finish_clause (tree, gimple_seq *); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); bool gfc_omp_private_outer_ref (tree); @@ -824,6 +829,8 @@ struct GTY((variable_size)) lang_decl { tree span; /* For assumed-shape coarrays. */ tree token, caf_offset; + unsigned int scalar_allocatable : 1; + unsigned int scalar_pointer : 1; }; @@ -834,6 +841,14 @@ struct GTY((variable_size)) lang_decl { #define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset #define GFC_DECL_SAVED_DESCRIPTOR(node) \ (DECL_LANG_SPECIFIC(node)->saved_descriptor) +#define GFC_DECL_SCALAR_ALLOCATABLE(node) \ + (DECL_LANG_SPECIFIC (node)->scalar_allocatable) +#define GFC_DECL_SCALAR_POINTER(node) \ + (DECL_LANG_SPECIFIC (node)->scalar_pointer) +#define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \ + (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0) +#define GFC_DECL_GET_SCALAR_POINTER(node) \ + (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_POINTER (node) : 0) #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) @@ -841,14 +856,13 @@ struct GTY((variable_size)) lang_decl { #define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node) #define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node) #define GFC_DECL_SUBREF_ARRAY_P(node) DECL_LANG_FLAG_6(node) +#define GFC_DECL_ASSOCIATE_VAR_P(node) DECL_LANG_FLAG_7(node) #define GFC_DECL_CLASS(node) DECL_LANG_FLAG_8(node) /* An array descriptor. */ #define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node) /* An array without a descriptor. */ #define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node) -/* Fortran POINTER type. */ -#define GFC_POINTER_TYPE_P(node) TYPE_LANG_FLAG_3(node) /* Fortran CLASS type. */ #define GFC_CLASS_TYPE_P(node) TYPE_LANG_FLAG_4(node) /* The GFC_TYPE_ARRAY_* members are present in both descriptor and |