|
Packit |
0848f5 |
! This file created from test/mpi/f77/comm/commnamef.f with f77tof90
|
|
Packit |
0848f5 |
! -*- Mode: Fortran; -*-
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! (C) 2003 by Argonne National Laboratory.
|
|
Packit |
0848f5 |
! See COPYRIGHT in top-level directory.
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
program main
|
|
Packit |
0848f5 |
use mpi
|
|
Packit |
0848f5 |
integer errs, ierr
|
|
Packit |
0848f5 |
integer comm(4), i, rlen, ln
|
|
Packit |
0848f5 |
integer ncomm
|
|
Packit |
0848f5 |
character*(MPI_MAX_OBJECT_NAME) inname(4), cname
|
|
Packit |
0848f5 |
logical MTestGetIntracomm
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
errs = 0
|
|
Packit |
0848f5 |
call mtest_init( ierr )
|
|
Packit |
0848f5 |
|
|
Packit |
0848f5 |
! Test the predefined communicators
|
|
Packit |
0848f5 |
do ln=1,MPI_MAX_OBJECT_NAME
|
|
Packit |
0848f5 |
cname(ln:ln) = 'X'
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
call mpi_comm_get_name( MPI_COMM_WORLD, cname, rlen, ierr )
|
|
Packit |
0848f5 |
do ln=MPI_MAX_OBJECT_NAME,1,-1
|
|
Packit |
0848f5 |
if (cname(ln:ln) .ne. ' ') then
|
|
Packit |
0848f5 |
if (ln .ne. rlen) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, 'result len ', rlen,' not equal to actual len ', &
|
|
Packit |
0848f5 |
& ln
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
goto 110
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
if (cname(1:rlen) .ne. 'MPI_COMM_WORLD') then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, 'Did not get MPI_COMM_WORLD for world'
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
110 continue
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
do ln=1,MPI_MAX_OBJECT_NAME
|
|
Packit |
0848f5 |
cname(ln:ln) = 'X'
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
call mpi_comm_get_name( MPI_COMM_SELF, cname, rlen, ierr )
|
|
Packit |
0848f5 |
do ln=MPI_MAX_OBJECT_NAME,1,-1
|
|
Packit |
0848f5 |
if (cname(ln:ln) .ne. ' ') then
|
|
Packit |
0848f5 |
if (ln .ne. rlen) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, 'result len ', rlen,' not equal to actual len ', &
|
|
Packit |
0848f5 |
& ln
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
goto 120
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
if (cname(1:rlen) .ne. 'MPI_COMM_SELF') then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, 'Did not get MPI_COMM_SELF for world'
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
120 continue
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
do i = 1, 4
|
|
Packit |
0848f5 |
if (MTestGetIntracomm( comm(i), 1, .true. )) then
|
|
Packit |
0848f5 |
ncomm = i
|
|
Packit |
0848f5 |
write( inname(i), '(a,i1)') 'myname',i
|
|
Packit |
0848f5 |
call mpi_comm_set_name( comm(i), inname(i), ierr )
|
|
Packit |
0848f5 |
else
|
|
Packit |
0848f5 |
goto 130
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
130 continue
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
! Now test them all
|
|
Packit |
0848f5 |
do i=1, ncomm
|
|
Packit |
0848f5 |
call mpi_comm_get_name( comm(i), cname, rlen, ierr )
|
|
Packit |
0848f5 |
if (inname(i) .ne. cname) then
|
|
Packit |
0848f5 |
errs = errs + 1
|
|
Packit |
0848f5 |
print *, ' Expected ', inname(i), ' got ', cname
|
|
Packit |
0848f5 |
endif
|
|
Packit |
0848f5 |
call MTestFreeComm( comm(i) )
|
|
Packit |
0848f5 |
enddo
|
|
Packit |
0848f5 |
!
|
|
Packit |
0848f5 |
call mtest_finalize( errs )
|
|
Packit |
0848f5 |
call mpi_finalize( ierr )
|
|
Packit |
0848f5 |
end
|