PROGRAM icc_group_template c c iCC group template c This program will form the row and column groups c of the given partition. Then a broadcast will c be performed along the row, followed by the column. c c IMPLICIT DOUBLE PRECISION (a-h,o-z) PARAMETER( nlen=100000,ilen=600 ) c DIMENSION x(nlen),y(nlen) INTEGER iroot c INTEGER i,j,k,l,m,n INTEGER my_node,num_nodes INTEGER nrow,ncol,myrow,mycol c PARAMETER( max_nranks=2000 ) INTEGER icomm_row, icomm_col INTEGER igroup_all, igroup_row, igroup_col, info INTEGER istat_node INTEGER i_rstart, i_cstart, i_row, i_col, i_rstride, i_cstride c c INCLUDE "iCC_groupf.h" c c......initialize groups c """"""""""""""""" istat_node = 6 CALL icc_g_group_init( info ) CALL icc_g_comm_rank( iCC_G_COMM_WORLD, my_node, info ) CALL icc_g_comm_size( iCC_G_COMM_WORLD, num_nodes, info ) CALL icc_g_comm_grid( iCC_G_COMM_WORLD, > nrow,ncol,myrow,mycol,info ) CALL icc_g_comm_group( iCC_G_COMM_WORLD, igroup_all, info ) IF ( my_node.EQ.istat_node ) then print *,'********** group all *************' CALL icc_g_group_info( igroup_all ) ENDIF CALL icc_g_barrier( iCC_G_COMM_WORLD, info ) c......Form row group c """""""""""""" i_rstart = myrow i_cstart = 0 i_row = 1 i_col = ncol i_rstride = 1 i_cstride = 1 CALL icc_g_group_block_incl( igroup_all, i_rstart, i_cstart, > i_row, i_rstride, i_col, i_cstride, > igroup_row, info ) IF ( my_node.EQ.istat_node ) then print *,'********** group row *************' CALL icc_g_group_info( igroup_row ) ENDIF IF ( igroup_row.NE.iCC_G_GROUP_NULL ) then CALL icc_g_comm_create( iCC_G_COMM_WORLD, igroup_row, > icomm_row, info ) ENDIF CALL icc_g_barrier( iCC_G_COMM_WORLD, info ) c......Form col group c """""""""""""" i_rstart = 0 i_cstart = mycol i_row = nrow i_col = 1 i_rstride = 1 i_cstride = 1 CALL icc_g_group_block_incl( igroup_all, i_rstart, i_cstart, > i_row, i_rstride, i_col, i_cstride, > igroup_col, info ) IF ( my_node.EQ.istat_node ) then print *,'********** group col *************' CALL icc_g_group_info( igroup_col ) ENDIF IF ( igroup_col.NE.iCC_G_GROUP_NULL ) then CALL icc_g_comm_create( iCC_G_COMM_WORLD, igroup_col, > icomm_col, info ) ENDIF CALL icc_g_barrier( iCC_G_COMM_WORLD, info ) c......Free the allocated groups c """"""""""""""""""""""""" IF ( igroup_row.NE.iCC_G_GROUP_NULL ) > CALL icc_g_group_free( igroup_row, info ) IF ( igroup_col.NE.iCC_G_GROUP_NULL ) > CALL icc_g_group_free( igroup_col, info ) IF ( igroup_all.NE.iCC_G_GROUP_NULL ) > CALL icc_g_group_free( igroup_all, info ) c......initialize variables c """""""""""""""""""" n=8000 iroot = 1 DO 10 i=1,n y(i) = 0.0 x(i) = my_node*1000.0 + 1.0*i 10 CONTINUE c......bcast in rows c """"""""""""" IF (my_node.EQ.istat_node) print *,'Calling icc_g_bcast in row' CALL icc_g_bcast( x,n,iCC_G_DOUBLE_PRECISION,iroot, > icomm_row,info ) IF (my_node.EQ.istat_node) print *, 'bcast row complete' IF (my_node.EQ.istat_node) print * c......bcast in cols c """"""""""""" IF (my_node.EQ.istat_node) print *,'Calling icc_g_bcast in col' CALL icc_g_bcast( x,n,iCC_G_DOUBLE_PRECISION,iroot, > icomm_col,info ) IF (my_node.EQ.istat_node) print *, 'bcast col complete' IF (my_node.EQ.istat_node) print * STOP END