1 program tctst 2 include 'mpif.h' 3 integer f77com, wgrp, f77grp, Iam, i, ierr 4 integer irank(2) 5 external Ccommcheck 6 integer Ccommcheck 7 8 call mpi_init(ierr) 9 call mpi_comm_size(MPI_COMM_WORLD, i, ierr) 10 call mpi_comm_rank(MPI_COMM_WORLD, Iam, ierr) 11 if (i .lt. 2) then 12 print*,'Need at least 2 processes to run test, aborting.' 13 else 14 if (Iam .eq. 0) then 15 print*,'If this routine does not complete successfully,' 16 print*,'Do _NOT_ set TRANSCOMM = -DCSameF77' 17 print*,' ' 18 print*,' ' 19 end if 20* 21* Form context with 2 members 22* 23 irank(1) = 0 24 irank(2) = 1 25 call mpi_comm_group(MPI_COMM_WORLD, wgrp, ierr) 26 call mpi_group_incl(wgrp, 2, irank, f77grp, ierr) 27 call mpi_comm_create(MPI_COMM_WORLD, f77grp, f77com, ierr) 28 call mpi_group_free(f77grp, ierr) 29 30 i = Ccommcheck(MPI_COMM_WORLD, f77com) 31 if (Iam .eq. 0) then 32 if (i .eq. 0) then 33 print*,'Do _NOT_ set TRANSCOMM = -DCSameF77' 34 else 35 print*,'Set TRANSCOMM = -DCSameF77' 36 end if 37 end if 38 39 if (f77grp .ne. MPI_COMM_NULL) call mpi_comm_free(f77com, ierr) 40 end if 41 call mpi_finalize(ierr) 42 43 stop 44 end 45