@@ -34,11 +34,15 @@ program native_multi_image
3434#endif
3535#ifndef HAVE_CO_BROADCAST
3636#define HAVE_CO_BROADCAST HAVE_COLLECTIVES
37+ #endif
38+ #ifndef HAVE_TEAM
39+ #define HAVE_TEAM 1
3740#endif
3841
3942 USE , INTRINSIC :: ISO_FORTRAN_ENV
40- integer :: me, ni, peer, tmp
43+ integer :: me, ni, peer, tmp, team_id
4144 character (len= 5 ) :: c
45+ type (team_type) :: subteam, res
4246
4347 me = THIS_IMAGE()
4448 ni = NUM_IMAGES()
@@ -91,6 +95,27 @@ program native_multi_image
9195 call CO_BROADCAST(c,1 )
9296# endif
9397
98+ #if HAVE_TEAM
99+ call status (" Testing TEAMS..." )
100+ res = get_team(CURRENT_TEAM)
101+ res = get_team(INITIAL_TEAM)
102+ res = get_team()
103+ write (* ,' (A,I3)' ) " Initial team number is " , team_number()
104+
105+ if (ni < 2 ) then
106+ if (me == 1 ) write (* ,' (A)' ) " Please run program again with at least 2 images to test more TEAM features."
107+ else
108+ team_id = merge (1 , 2 , me <= ni/ 2 )
109+ form team(team_id, subteam)
110+ sync team(subteam)
111+ change team(subteam)
112+ write (* ,' (A,I3,A,I3,A,I3)' ) ' Inside CHANGE TEAM construct: ' , this_image(), ' of ' , num_images(), ' in team number ' , team_number()
113+ end team
114+ call sync_all
115+ write (* ,' (A,I3)' ) " After END TEAM statement, TEAM_NUMBER() is " , team_number()
116+ end if
117+ #endif
118+
94119 call sync_all
95120 write (* ,' (A,I1,A,I1,A)' ) " Goodbye from image " , me, " of " , ni, " images"
96121
0 commit comments