namepubf90.f90

fortran并行计算包

! This file created from test/mpi/f77/spawn/namepubf.f with f77tof90
! -*- Mode: Fortran; -*- 
!
! (C) 2003 by Argonne National Laboratory.
!     See COPYRIGHT in top-level directory.
!
      program main
      use mpi
      integer errs
      character*(MPI_MAX_PORT_NAME) port_name
      character*(MPI_MAX_PORT_NAME) port_name_out
      character*(256) serv_name
      integer merr, mclass
      character*(MPI_MAX_ERROR_STRING) errmsg
      integer msglen, rank
      integer ierr

      errs = 0
      call MTest_Init( ierr )
      call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr )

!       Note that according to the MPI standard, port_name must
!       have been created by MPI_Open_port.  For current testing
!       purposes, we'll use a fake name.  This test should eventually use
!       a valid name from Open_port 

      port_name = 'otherhost:122'
      serv_name = 'MyTest'
      
      call MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN, &
      &     ierr )

      if (rank .eq. 0) then
         merr = -1
         call MPI_Publish_name( serv_name, MPI_INFO_NULL, port_name, &
      &        merr )
         if (merr .ne. MPI_SUCCESS) then
            errs = errs + 1
            call MPI_Error_string( merr, errmsg, msglen, ierr )
            print *, "Error in Publish_name ", errmsg(1:msglen)
         endif

         call MPI_Barrier(MPI_COMM_WORLD, ierr )
         call MPI_Barrier(MPI_COMM_WORLD, ierr )
        
         merr = -1
         call MPI_Unpublish_name( serv_name, MPI_INFO_NULL, port_name, &
      &        merr)
         if (merr .ne. MPI_SUCCESS) then
            errs = errs + 1
            call MPI_Error_string( merr, errmsg, msglen, ierr )
            print *,  "Error in Unpublish name ", errmsg(1:msglen)
         endif
      else
         call MPI_Barrier(MPI_COMM_WORLD, ierr )
         merr = -1
         call MPI_Lookup_name( serv_name, MPI_INFO_NULL, port_name_out, &
      &        merr)
         if (merr .ne. MPI_SUCCESS) then
            errs = errs + 1
            call MPI_Error_string( merr, errmsg, msglen, ierr )
            print *, "Error in Lookup name", errmsg(1:msglen)
         else 
            if (port_name .ne. port_name_out) then
                errs = errs + 1
                print *, "Lookup name returned the wrong value (", &
      &               port_name_out, "), expected (", port_name, ")" 
             endif
          endif

        call MPI_Barrier(MPI_COMM_WORLD, ierr )
      endif

      call MPI_Barrier(MPI_COMM_WORLD, ierr )
    
      merr = -1
      call MPI_Lookup_name( serv_name, MPI_INFO_NULL, port_name_out, &
      &     merr )
      if (merr .eq. MPI_SUCCESS) then
         errs = errs + 1
         print *, "Lookup name returned name after it was unpublished"
      else
!       Must be class MPI_ERR_NAME 
         call MPI_Error_class( merr, mclass, ierr )
        if (mclass .ne. MPI_ERR_NAME) then
            errs = errs + 1
            call MPI_Error_string( merr, errmsg, msglen, ierr )
            print *,    "Lookup name returned the wrong error class &
      &           (",mclass,"), msg ", errmsg

         endif
      endif
      
      call MTest_Finalize( errs )
      call MPI_Finalize( ierr )
      end