Hi Tobias! On 2026-09-26T11:01:01+0200, Tobias Burnus <[email protected]> wrote: > Tobias Burnus wrote: >> Similar to CUDA language's __SHARED__ attribute that turns static variables
(Actually, not only 'static' ones; it causes additional semantic changes... But that's not relevant to your case, here.) >> into variables that are only shared with threads (workers) on the same >> streaming processor, OpenMP's 'omp groupprivate' also makes the variable >> only shared within the same contention group (also known as 'team'). >> >> This patch enabled OpenMP's groupprivate support for Fortran but >> only for offloading to Nvidia GPUs. > > Now pushed as r17-4677-g84d93bc97a3610 Hey, in a message on Friday night you said that I have until today to review this. ;-O On 2026-09-22T15:40:53+0200, Tobias Burnus <[email protected]> wrote: > @Thomas: Is the nvptx change OK? > --- a/gcc/config/nvptx/nvptx.cc > +++ b/gcc/config/nvptx/nvptx.cc > @@ -484,7 +484,8 @@ nvptx_encode_section_info (tree decl, rtx rtl, int first) > > if (VAR_P (decl)) > { > - if (lookup_attribute ("shared", DECL_ATTRIBUTES (decl))) > + if (lookup_attribute ("shared", DECL_ATTRIBUTES (decl)) > + || lookup_attribute ("omp groupprivate", DECL_ATTRIBUTES (decl))) > { > area = DATA_AREA_SHARED; Yes, sure. So, a few weeks ago, I was doing a "very similar" thing in a different context, and I first tried the very same thing that you did here, but then didn't see the attribure propagated from host to nvptx offloading compilation or didn't see 'nvptx_encode_section_info' get called for the variable (don't remember now which of the two it was) -- but I now have an idea what might've been the reason; to be checked (on my side). what I then did, was to mark up the variable host-side with attribute 'oacc gang-private' (à la 'nvptx_goacc_adjust_private_decl' as called via 'TARGET_GOACC_ADJUST_PRIVATE_DECL'/'targetm.goacc.adjust_private_decl' from 'gcc/omp-offload.cc:execute_oacc_device_lower' in order to OpenACC gang-privatize variables), and then let 'nvptx_goacc_expand_var_decl' as called via 'TARGET_GOACC_EXPAND_VAR_DECL'/'targetm.goacc.expand_var_decl' from 'gcc/expr.cc:expand_expr_real_1', 'case VAR_DECL' handle this, which worked fine, for "my" case. Why I'm mentioning this: even though the AMD GPU code offloading implementation of OpenACC gang-private variables is different (see 'gcc/omp-offload.cc:execute_oacc_device_lower', "Regarding the OpenACC privatization level, [...]"), but I suppose... > PS: [...] missing [...] LDS implementation > support for GCN ... that it should be possible to re-purpose it for both "your" and "my" cases. > I currently do > not see us supporting groupprivate on the host for static variables. If I remember correctly, we had or maybe still have some code in 'libgomp/target.c', to implement 'firstprivate' etc. for OpenMP 'target' in host-fallback execution (using 'malloc') -- maybe something (conceptually) similar is applicale for 'groupprivate'? > Note: There is also 'dyn_groupprivate' which is related but quite > differently handled (spec wise and implementation wise). ACK. Grüße Thomas > commit 84d93bc97a3610446c4e19fa84d5a10f8b668358 > Author: Tobias Burnus <[email protected]> > Date: Sat Sep 26 10:57:31 2026 +0200 > > OpenMP: ME, nvptx, Fortran: enable 'omp groupprivate' for nvptx offload > > OpenMP's groupprivate variables are static variables that are have a copy > per team - which matches Nvidia's 'shared' variables. This commit enables > the support for offload to nvptx devices, only. Hence, a sorry is printed > unless device_type(nohost) is used - and likewise when attempting to use > them with GCN devices. > > Note: As currently the variable is still output to the host-side assembler > code, accessing it from the host is still possible, but unless there is > only a single variable for all teams! > > gcc/c-family/ChangeLog: > > * c-attribs.cc (c_common_gnu_attributes): Add "omp groupprivate". > > gcc/ChangeLog: > > * config/nvptx/nvptx.cc (nvptx_encode_section_info): Handle > 'omp groupprivate'. > * varpool.cc (varpool_node::get_create): Print sorry for > 'omp groupprivate' variables except for device_type(nohost) and > no offloading or nvptx offloading. > > gcc/fortran/ChangeLog: > > * f95-lang.cc (gfc_gnu_attributes): Add "omp groupprivate". > * trans-common.cc (build_common_decl): Enable 'omp groupprivate'. > * trans-decl.cc (add_attributes_to_decl): Likewise. > > gcc/testsuite/ChangeLog: > > * gfortran.dg/gomp/groupprivate-1.f90: Update sorry output. > * gfortran.dg/gomp/groupprivate-4.f90: Likewise. > > libgomp/ChangeLog: > > * libgomp.texi (Impl.Status): Mark 'omp groupprivate' as > partially supported. > * testsuite/libgomp.fortran/groupprivate-1.f90: New test. > * testsuite/libgomp.fortran/groupprivate-2.f90: New test. > --- > gcc/c-family/c-attribs.cc | 2 + > gcc/config/nvptx/nvptx.cc | 3 +- > gcc/fortran/f95-lang.cc | 2 + > gcc/fortran/trans-common.cc | 9 +- > gcc/fortran/trans-decl.cc | 13 +-- > gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 | 15 +-- > gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 | 14 +-- > gcc/varpool.cc | 27 ++++++ > libgomp/libgomp.texi | 3 +- > .../testsuite/libgomp.fortran/groupprivate-1.f90 | 100 ++++++++++++++++++++ > .../testsuite/libgomp.fortran/groupprivate-2.f90 | 102 > +++++++++++++++++++++ > 11 files changed, 260 insertions(+), 30 deletions(-) > > diff --git a/gcc/c-family/c-attribs.cc b/gcc/c-family/c-attribs.cc > index 0e2e17cc0be..1e6e21005d3 100644 > --- a/gcc/c-family/c-attribs.cc > +++ b/gcc/c-family/c-attribs.cc > @@ -619,6 +619,8 @@ const struct attribute_spec c_common_gnu_attributes[] = > handle_omp_declare_target_attribute, NULL }, > { "omp declare target nohost", 0, 0, true, false, false, false, > handle_omp_declare_target_attribute, NULL }, > + { "omp groupprivate", 0, 0, true, false, false, false, > + handle_omp_declare_target_attribute, NULL }, > { "non overlapping", 0, 0, true, false, false, false, > handle_non_overlapping_attribute, NULL }, > { "alloc_align", 1, 1, false, true, true, false, > diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc > index fb76e781350..39ea6e6f923 100644 > --- a/gcc/config/nvptx/nvptx.cc > +++ b/gcc/config/nvptx/nvptx.cc > @@ -484,7 +484,8 @@ nvptx_encode_section_info (tree decl, rtx rtl, int first) > > if (VAR_P (decl)) > { > - if (lookup_attribute ("shared", DECL_ATTRIBUTES (decl))) > + if (lookup_attribute ("shared", DECL_ATTRIBUTES (decl)) > + || lookup_attribute ("omp groupprivate", DECL_ATTRIBUTES (decl))) > { > area = DATA_AREA_SHARED; > if (DECL_INITIAL (decl)) > diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc > index bfc2651c076..10d18fe5a22 100644 > --- a/gcc/fortran/f95-lang.cc > +++ b/gcc/fortran/f95-lang.cc > @@ -100,6 +100,8 @@ static const attribute_spec gfc_gnu_attributes[] = > gfc_handle_omp_declare_target_attribute, NULL }, > { "oacc function", 0, -1, true, false, false, false, > gfc_handle_omp_declare_target_attribute, NULL }, > + { "omp groupprivate", 0, 0, true, false, false, false, > + gfc_handle_omp_declare_target_attribute, NULL }, > }; > > static const scoped_attribute_specs gfc_gnu_attribute_table = > diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc > index 5458237a002..2674ef374e1 100644 > --- a/gcc/fortran/trans-common.cc > +++ b/gcc/fortran/trans-common.cc > @@ -467,6 +467,9 @@ build_common_decl (gfc_common_head *com, tree union_type, > bool is_init) > > gfc_set_decl_location (decl, &com->where); > > + if (com->omp_groupprivate) > + DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp groupprivate"), > + NULL_TREE, DECL_ATTRIBUTES (decl)); > tree arg_list = NULL_TREE; > if (com->omp_device_type != OMP_DEVICE_TYPE_UNSET) > { > @@ -488,12 +491,6 @@ build_common_decl (gfc_common_head *com, tree > union_type, bool is_init) > arg_list = tree_cons (NULL_TREE, get_identifier (arg_str), arg_list); > } > > - /* Also check trans-decl.cc when updating/removing the following; > - also update f95.c's gfc_gnu_attributes. */ > - if (com->omp_groupprivate) > - gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, used by common " > - "block %</%s/%> declared at %L", com->name, &com->where); > - > if (com->omp_declare_target_link) > DECL_ATTRIBUTES (decl) > = tree_cons (get_identifier ("omp declare target link"), > diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc > index dc17b658d10..2b7ef12c1a8 100644 > --- a/gcc/fortran/trans-decl.cc > +++ b/gcc/fortran/trans-decl.cc > @@ -1582,12 +1582,13 @@ add_attributes_to_decl (tree *decl_p, const > gfc_symbol *sym) > clauses = c; > } > > - /* FIXME: 'declare_target_link' permits both any and host, but > - will fail if one sets OMP_CLAUSE_DEVICE_TYPE_KIND. */ > + if (sym_attr.omp_groupprivate) > + list = tree_cons (get_identifier ("omp groupprivate"), NULL_TREE, list); > + > tree arg_list = NULL_TREE; > if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET > && !sym_attr.omp_declare_target_link > - && !sym_attr.omp_declare_target_indirect /* implies 'any' */) > + && !sym_attr.omp_declare_target_indirect) > { > const char *arg_str = NULL; > switch (sym_attr.omp_device_type) > @@ -1607,12 +1608,6 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol > *sym) > arg_list = tree_cons (NULL_TREE, get_identifier (arg_str), arg_list); > } > > - /* Also check trans-common.cc when updating/removing the following; > - also update f95.c's gfc_gnu_attributes. */ > - if (sym_attr.omp_groupprivate) > - gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, " > - "used by %qs declared at %L", sym->name, &sym->declared_at); > - > bool has_declare = true; > > if (flag_openmp) > diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 > b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 > index 1d9f5492d6a..80bf6c61023 100644 > --- a/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 > +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 > @@ -2,13 +2,14 @@ module m > implicit none > integer :: ii > integer :: x, y(20), z, v, u, k > -! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'x' declared > at .1." "" { target *-*-* } .-1 } > -! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'y' declared > at .1." "" { target *-*-* } .-2 } > -! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'z' declared > at .1." "" { target *-*-* } .-3 } > -! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'v' declared > at .1." "" { target *-*-* } .-4 } > -! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'u' declared > at .1." "" { target *-*-* } .-5 } > -! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'k' declared > at .1." "" { target *-*-* } .-6 } > -! > + ! { dg-message "sorry, unimplemented: 'k' with 'omp groupprivate' on the > host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-1 } > + ! { dg-message "sorry, unimplemented: 'u' with 'omp groupprivate' on the > host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-2 } > + ! { dg-message "sorry, unimplemented: 'x' with 'omp groupprivate' on the > host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-3 } > + ! { dg-message "sorry, unimplemented: 'y' with 'omp groupprivate' on the > host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-4 } > + ! { dg-message "sorry, unimplemented: 'z' with 'omp groupprivate' on the > host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-5 } > + > + ! { dg-prune-output "sorry, unimplemented: 'v' with 'omp groupprivate' on > devices other than" } > + > !$omp groupprivate(x, z) device_Type( any ) > !$omp declare target local(x) device_type ( any ) > !$omp declare target enter( ii) ,local(y), device_type ( host ) > diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 > b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 > index a980c1fa0bd..278b9b51343 100644 > --- a/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 > +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 > @@ -4,12 +4,14 @@ module m > integer :: x, y(20), z, v, u, k > > common /b_ii/ ii > - common /b_x/ x ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used > by common block '/b_x/' declared at .1." } > - common /b_y/ y ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used > by common block '/b_y/' declared at .1." } > - common /b_z/ z ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used > by common block '/b_z/' declared at .1." } > - common /b_v/ v ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used > by common block '/b_v/' declared at .1." } > - common /b_u/ u ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used > by common block '/b_u/' declared at .1." } > - common /b_k/ k ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used > by common block '/b_k/' declared at .1." } > + common /b_x/ x ! { dg-message "sorry, unimplemented: 'b_x' with 'omp > groupprivate' on the host; try 'device_type\\(nohost\\)'" } > + common /b_y/ y ! { dg-message "sorry, unimplemented: 'b_y' with 'omp > groupprivate' on the host; try 'device_type\\(nohost\\)'" } > + common /b_z/ z ! { dg-message "sorry, unimplemented: 'b_z' with 'omp > groupprivate' on the host; try 'device_type\\(nohost\\)'" } > + common /b_v/ v > + common /b_u/ u ! { dg-message "sorry, unimplemented: 'b_u' with 'omp > groupprivate' on the host; try 'device_type\\(nohost\\)'" } > + common /b_k/ k ! { dg-message "sorry, unimplemented: 'b_k' with 'omp > groupprivate' on the host; try 'device_type\\(nohost\\)'" } > + > + ! { dg-prune-output "sorry, unimplemented: 'b_v' with 'omp groupprivate' on > devices other than" } > > !$omp groupprivate(/b_x/, /b_z/) device_Type( any ) > !$omp declare target local(/b_x/) device_type ( any ) > diff --git a/gcc/varpool.cc b/gcc/varpool.cc > index b62fba99996..d30bd248e18 100644 > --- a/gcc/varpool.cc > +++ b/gcc/varpool.cc > @@ -156,6 +156,33 @@ varpool_node::get_create (tree decl) > DECL_ATTRIBUTES (decl)))) > { > node->offloadable = 1; > + if (lookup_attribute ("omp groupprivate", DECL_ATTRIBUTES (decl))) > + { > + if (!value_member (get_identifier ("device_type(nohost)"), > + TREE_VALUE (attr)) > + && !lookup_attribute ("omp declare target nohost", > + DECL_ATTRIBUTES (decl))) > + /* FIXME: value_member is Fortran, nohost attribute is C/C++. */ > + sorry_at (DECL_SOURCE_LOCATION (decl), > + "%qD with %<omp groupprivate%> on the host; " > + "try %<device_type(nohost)%>", decl); > + else > + for (const char *c = getenv ("OFFLOAD_TARGET_NAMES"); c;) > + { > + if (startswith (c, "nvptx")) /* Supported. */ > + { > + if ((c = strchr (c, ':'))) > + c++; > + } > + else > + { > + sorry_at (DECL_SOURCE_LOCATION (decl), > + "%qD with %<omp groupprivate%> on devices other " > + "than nvptx; try %<-foffload=nvptx-none%>", decl); > + break; > + } > + } > + } > if (ENABLE_OFFLOADING && !DECL_EXTERNAL (decl)) > { > g->have_offload = true; > diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi > index 4a106983308..7f34a36e38b 100644 > --- a/libgomp/libgomp.texi > +++ b/libgomp/libgomp.texi > @@ -533,7 +533,8 @@ to address of matching mapped list item per 5.1, Sect. > 2.21.7.2 @tab N @tab > @item @code{delete} as delete-modifier not as map type @tab N @tab > @item For Fortran, the @code{automap} modifier to the @code{enter} clause > of @code{declare_target} @tab N @tab > -@item @code{groupprivate} directive @tab N @tab > +@item @code{groupprivate} directive @tab P @tab > + Only Fortran with @code{device_type(nohost)} with only nvptx GPUs > @item @code{local} clause to @code{declare_target} directive @tab N @tab > @item @code{part_size} allocator trait for @code{interleaved} allocator > partitions @tab N @tab > diff --git a/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90 > b/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90 > new file mode 100644 > index 00000000000..27156aae1f8 > --- /dev/null > +++ b/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90 > @@ -0,0 +1,100 @@ > +! { dg-do run { target offload_device_nvptx } } > +! { dg-additional-options "-O0 -foffload=nvptx-none" } > +! > +! FIXME: Enable testing for AMD GCN once implemented > +! > +! The following code works if > +! - either 'target teams' runs in sequence order (this seems to happen on the > +! host for 'target teams' but not for 'teams') > +! - or, when teams run concurrently, if 'cnt' and 'local_cnt' are > 'groupprivate'. > +! > +! The latter is check by this testcase. > +! > +! On nvptx, such memory is called 'shared' and it turns out that the address > +! is the same for all teams. However, the value check only succeeds if it is > +! indeed shared! The produced nvptx assembly is: > +! .shared .align 4 .u32 local_cnt$1[1]; > +! .visible .shared .align 4 .u32 __m_MOD_cnt[1]; > +! > +module m > + use iso_c_binding > + use omp_lib > + implicit none > + > + integer :: cnt ! Note that no initializer is permitted! > + !$omp declare target local(cnt) device_type(nohost) > + !$omp groupprivate(cnt) device_type(nohost) > + > +contains > + > + integer(c_ptrdiff_t) function addr() > + addr = loc(cnt) > + end > + > + integer function f_global(first) > + !$omp declare target enter(f_global) device_type(nohost) > + logical, value, intent(in) :: first > + > + if (first) then > + !$omp atomic write > + cnt = 0 > + end if > + !$omp atomic update > + cnt = cnt + (omp_get_team_num () + 1); > + !$omp atomic read > + f_global = cnt > + end > + > + integer function f_local(first) > + !$omp declare target enter(f_local) device_type(nohost) > + logical, value, intent(in) :: first > + integer, save :: local_cnt > + !$omp groupprivate(local_cnt) device_type(nohost) > + > + if (first) then > + !$omp atomic write > + local_cnt = 5 > + end if > + !$omp atomic update > + local_cnt = local_cnt + 2*(omp_get_team_num () + 1); > + !$omp atomic read > + f_local = local_cnt > + end > +end module m > + > +program main > + use m > + implicit none > + integer :: team_global(16), team_local(16), j, num_teams > + integer(c_ptrdiff_t) :: addrs(16) > + > + ! !$omp teams num_teams(16) > + !$omp target teams num_teams(16) map(from: team_global, team_local, > num_teams) device_type(nohost) > + block > + !$omp parallel if(.false.) > + block > + integer :: i > + real, volatile :: x > + x = 3.3 > + i = f_global(.true.) > + i = f_local(.true.) > + addrs(1+omp_get_team_num()) = addr() > + x = sin(x) > + team_global(1+omp_get_team_num()) = f_global(.false.) > + team_local(1+omp_get_team_num()) = f_local(.false.) > + if (omp_get_team_num() == 0) & > + num_teams = omp_get_num_teams () > + end block > + end block > + > + if (num_teams /= 16) error stop "num teams error" > + > + do j = 1, 16 > + if (team_global(j) /= j*2 .or. team_local(j) /= 5+j*4) then > + print '(i2,": ", 4(i6, " "), g0, " ", g0, " - ", z16)', j,& > + team_global(j), team_local(j), j*2, 5+j*4, & > + team_global(j)==j*2, team_local(j)==5+j*4, addrs(j) > + error stop "invalid value" > + end if > + end do > +end > diff --git a/libgomp/testsuite/libgomp.fortran/groupprivate-2.f90 > b/libgomp/testsuite/libgomp.fortran/groupprivate-2.f90 > new file mode 100644 > index 00000000000..f52c1d095ff > --- /dev/null > +++ b/libgomp/testsuite/libgomp.fortran/groupprivate-2.f90 > @@ -0,0 +1,102 @@ > +! { dg-do run { target offload_device_nvptx } } > +! { dg-additional-options "-O0 -foffload=nvptx-none" } > +! > +! FIXME: Enable testing for AMD GCN once implemented > +! > +! The following code works if > +! - either 'target teams' runs in sequence order (this seems to happen on the > +! host for 'target teams' but not for 'teams') > +! - or, when teams run concurrently, if 'cnt' and 'local_cnt' are > 'groupprivate'. > +! > +! The latter is check by this testcase. > +! > +! On nvptx, such memory is called 'shared' and it turns out that the address > +! is the same for all teams. However, the value check only succeeds if it is > +! indeed shared! The produced nvptx assembly is: > +! .shared .align 4 .u32 local_cnt$1[1]; > +! .visible .shared .align 4 .u32 __m_MOD_cnt[1]; > +! > +module m > + use iso_c_binding > + use omp_lib > + implicit none > + > + integer :: cnt ! Note that no initializer is permitted! > + common /one/ cnt > + !$omp declare target local(/one/) device_type(nohost) > + !$omp groupprivate(/one/) device_type(nohost) > + > +contains > + > + integer(c_ptrdiff_t) function addr() > + addr = loc(cnt) > + end > + > + integer function f_global(first) > + !$omp declare target enter(f_global) device_type(nohost) > + logical, value, intent(in) :: first > + > + if (first) then > + !$omp atomic write > + cnt = 0 > + end if > + !$omp atomic update > + cnt = cnt + (omp_get_team_num () + 1); > + !$omp atomic read > + f_global = cnt > + end > + > + integer function f_local(first) > + !$omp declare target enter(f_local) device_type(nohost) > + logical, value, intent(in) :: first > + integer :: local_cnt > + common /two/ local_cnt > + !$omp groupprivate(/two/) device_type(nohost) > + > + if (first) then > + !$omp atomic write > + local_cnt = 5 > + end if > + !$omp atomic update > + local_cnt = local_cnt + 2*(omp_get_team_num () + 1); > + !$omp atomic read > + f_local = local_cnt > + end > +end module m > + > +program main > + use m > + implicit none > + integer :: team_global(16), team_local(16), j, num_teams > + integer(c_ptrdiff_t) :: addrs(16) > + > + ! !$omp teams num_teams(16) > + !$omp target teams num_teams(16) map(from: team_global, team_local, > num_teams) device_type(nohost) > + block > + !$omp parallel if(.false.) > + block > + integer :: i > + real, volatile :: x > + x = 3.3 > + i = f_global(.true.) > + i = f_local(.true.) > + addrs(1+omp_get_team_num()) = addr() > + x = sin(x) > + team_global(1+omp_get_team_num()) = f_global(.false.) > + team_local(1+omp_get_team_num()) = f_local(.false.) > + if (omp_get_team_num() == 0) & > + num_teams = omp_get_num_teams () > + end block > + end block > + > + if (num_teams /= 16) error stop "num teams error" > + > + do j = 1, 16 > + if (team_global(j) /= j*2 .or. team_local(j) /= 5+j*4) then > + print '(i2,": ", 4(i6, " "), g0, " ", g0, " - ", z16)', j,& > + team_global(j), team_local(j), j*2, 5+j*4, & > + team_global(j)==j*2, team_local(j)==5+j*4, addrs(j) > + error stop "invalid value" > + end if > + end do > +end
