Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
remove older mpich test suite
[simgrid.git] / teshsuite / smpi / mpich-test / context / commnamesf.f
diff --git a/teshsuite/smpi/mpich-test/context/commnamesf.f b/teshsuite/smpi/mpich-test/context/commnamesf.f
deleted file mode 100644 (file)
index e816a8c..0000000
+++ /dev/null
@@ -1,75 +0,0 @@
-C
-C Check the communicator naming functions from Fortran
-C
-
-      include 'mpif.h'
-
-      integer error, namelen
-      integer errcnt, rank
-      character*40 the_name
-      character*40 other_name
-
-      call mpi_init (error)
-      
-      errcnt = 0
-      call xify(the_name)
-
-      call mpi_comm_get_name (MPI_COMM_WORLD, the_name, namelen, error)
-      if (error .ne. mpi_success) then
-         errcnt = errcnt + 1
-         print *,'Failed to get the name from MPI_COMM_WORLD'
-         call MPI_Abort( MPI_COMM_WORLD, 1, error )
-      end if
-
-      if (the_name .ne. 'MPI_COMM_WORLD') then
-         errcnt = errcnt + 1
-         print *,'The name on MPI_COMM_WORLD is not "MPI_COMM_WORLD"'
-         call MPI_Abort( MPI_COMM_WORLD, 1, error )
-      end if
-
-      other_name = 'foobarH'
-      call mpi_comm_set_name(MPI_COMM_WORLD, other_name(1:6), error)
-
-      if (error .ne. mpi_success) then
-         errcnt = errcnt + 1
-         print *,'Failed to put a name onto MPI_COMM_WORLD'
-         call MPI_Abort( MPI_COMM_WORLD, 1, error )
-      end if
-      
-      call xify(the_name)
-
-      call mpi_comm_get_name (MPI_COMM_WORLD, the_name, namelen, error)
-      if (error .ne. mpi_success) then
-         errcnt = errcnt + 1
-         print *,'Failed to get the name from MPI_COMM_WORLD ',
-     $        'after setting it'
-         call MPI_Abort( MPI_COMM_WORLD, 1, error )
-      end if
-
-      if (the_name .ne. 'foobar') then
-         errcnt = errcnt + 1
-         print *,'The name on MPI_COMM_WORLD is not "foobar"'
-         print *, 'Got ', the_name
-         call MPI_Abort( MPI_COMM_WORLD, 1, error )
-      end if
-
-      call mpi_comm_rank( MPI_COMM_WORLD, rank, error )
-      if (errcnt .eq. 0 .and. rank .eq. 0) then
-         print *, ' No Errors'
-      endif
-      call mpi_finalize(error)
-      end
-
-
-      subroutine xify( string )
-      character*(*) string
-
-      integer i
-
-      do i = 1,len(string)
-         string(i:i) = 'X'
-      end do
-
-      end
-
-