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