1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
10 integer comm(4), i, rlen, ln
12 character*(MPI_MAX_OBJECT_NAME) inname(4), cname
13 logical MTestGetIntracomm
16 call mtest_init( ierr )
18 C Test the predefined communicators
19 do ln=1,MPI_MAX_OBJECT_NAME
22 call mpi_comm_get_name( MPI_COMM_WORLD, cname, rlen, ierr )
23 do ln=MPI_MAX_OBJECT_NAME,1,-1
24 if (cname(ln:ln) .ne. ' ') then
25 if (ln .ne. rlen) then
27 print *, 'result len ', rlen,' not equal to actual len ',
33 if (cname(1:rlen) .ne. 'MPI_COMM_WORLD') then
35 print *, 'Did not get MPI_COMM_WORLD for world'
39 do ln=1,MPI_MAX_OBJECT_NAME
42 call mpi_comm_get_name( MPI_COMM_SELF, cname, rlen, ierr )
43 do ln=MPI_MAX_OBJECT_NAME,1,-1
44 if (cname(ln:ln) .ne. ' ') then
45 if (ln .ne. rlen) then
47 print *, 'result len ', rlen,' not equal to actual len ',
53 if (cname(1:rlen) .ne. 'MPI_COMM_SELF') then
55 print *, 'Did not get MPI_COMM_SELF for world'
60 if (MTestGetIntracomm( comm(i), 1, .true. )) then
62 write( inname(i), '(a,i1)') 'myname',i
63 call mpi_comm_set_name( comm(i), inname(i), ierr )
72 call mpi_comm_get_name( comm(i), cname, rlen, ierr )
73 if (inname(i) .ne. cname) then
75 print *, ' Expected ', inname(i), ' got ', cname
77 call MTestFreeComm( comm(i) )
80 call mtest_finalize( errs )
81 call mpi_finalize( ierr )