Search code examples
fortranmpi

Any way to cycle between different messages with MPI_PROBE


I use MPI_Probe to determine the size of a dynamic array that i just pass as a tag. but i send two arrays. the basic structure is :

call MPI_Isend(message, destination, MPI_INT, size, COMM, status, error) 
call MPI_Isend(message2, destination, MPI_DOUBLE, size*3, COMM, status, error) 

... 

call MPI_Probe(sender, MPI_ANY_TAG, COMM, status, error) 
size1 = status(MPI_TAG) 

call MPI_Probe(sender, MPI_ANY_TAG, COMM, status, error) 
size2 = status(MPI_TAG) 

actual_size = MIN(size1, size2) 

call MPI_Recv(size) 
call MPI_Recv(size*3)

So this doesn't work because MPI_Probe will just get same value twice. Any idea how to cycle through different probes or something?

If this doesn't work i plan to change my code around to just have send - recv - send - recv instead of send - send - recv - recv. Just checking if someone has better solutions


Solution

  • As stated in the comments you shouldn't use the tag to send size data from one process to another as the value the tag can take has an upper bound of MPI_TAG_UB that in theory could be quite small, potentially not allow you to communicate a large enough integer. In fact it's bad practice to use the tag to transmit information at all, you should use the message data, that's what it is for after. Victor Eijkhout has the right way, you should inquire of the status argument using MPI_GET_COUNT how many things are being transmitted and use that to allocate the dynamic array. Here is an example, which also uses the correct handles for datatypes, you are using the C rather than the Fortran variants:

    ijb@ijb-Latitude-5410:~/work/stack$ cat probe.f90
    Program probe
    
      Use, Intrinsic :: iso_fortran_env, Only : stdout => output_unit
      
      Use mpi_f08, Only : mpi_status, mpi_comm_world, mpi_integer, &
           mpi_init, mpi_finalize, mpi_send, mpi_probe, mpi_get_count, mpi_recv
      
      Implicit None
    
      Type( mpi_status ) :: status
      
      Real :: rnd
    
      Integer, Dimension( : ), Allocatable :: stuff 
      
      Integer :: nprc, rank
      Integer :: n
      Integer :: error
      Integer :: i
    
      Call mpi_init( error )
    
      Call mpi_comm_size( mpi_comm_world, nprc, error )
      Call mpi_comm_rank( mpi_comm_world, rank, error )
    
      If( rank == 0 ) Then
         Write( stdout, * ) 'Running on ', nprc, ' procs'
      End If
    
      If( rank == 0 ) Then
         ! On rank zero generate a random sized array
         Call Random_number( rnd )
         n = Int( 10.0 * rnd + 1 )
         Write( stdout, * ) 'Allocating ', n, ' elements on rank 0'
         Allocate( stuff( 1:n ) )
         stuff = [ ( i, i = 1, n ) ]
         Write( stdout, '( "Data on proc 0: ", *( i0, 1x ) )' ) stuff
         Call mpi_send( stuff, Size( stuff ), mpi_integer, 1, 10, &
              mpi_comm_world, error )
    
      Else If( rank == 1 ) Then
         ! On rank 1 probe the message to get the status
         Call mpi_probe( 0, 10, mpi_comm_world, status, error )
         ! From the status find how many things are being sent
         Call mpi_get_count( status, mpi_integer, n, error )
         ! Use that to allocate the array
         Allocate( stuff( 1:n ) )
         ! And recv the date
         Call mpi_recv( stuff, Size( stuff ), mpi_integer, 0, 10, &
              mpi_comm_world, status, error )
         Write( stdout, * ) 'Recvd ', n, ' integers on proc 1'
         Write( stdout, '( "Data on proc 1: ", *( i0, 1x ) )' ) stuff
         
      Else
         Write( stdout, * ) 'Busy doing nothing ... ', rank
    
      End If
    
      Write( stdout, * ) 'done', rank
    
      Call mpi_finalize( error )
      
    End Program probe
    ijb@ijb-Latitude-5410:~/work/stack$ mpif90 --version
    GNU Fortran (Ubuntu 9.4.0-1ubuntu1~20.04.1) 9.4.0
    Copyright (C) 2019 Free Software Foundation, Inc.
    This is free software; see the source for copying conditions.  There is NO
    warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    
    ijb@ijb-Latitude-5410:~/work/stack$ mpif90 -std=f2018 -Wall -Wextra -pedantic -fcheck=all -fbacktrace -Wuse-without-only -Werror -g probe.f90 
    ijb@ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out 
     Running on            2  procs
     Allocating            8  elements on rank 0
    Data on proc 0: 1 2 3 4 5 6 7 8
     done           0
     Recvd            8  integers on proc 1
    Data on proc 1: 1 2 3 4 5 6 7 8
     done           1
    ijb@ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out 
     Running on            2  procs
     Allocating            5  elements on rank 0
    Data on proc 0: 1 2 3 4 5
     done           0
     Recvd            5  integers on proc 1
    Data on proc 1: 1 2 3 4 5
     done           1
    ijb@ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out 
     Running on            2  procs
     Allocating            2  elements on rank 0
    Data on proc 0: 1 2
     done           0
     Recvd            2  integers on proc 1
    Data on proc 1: 1 2
     done           1
    ijb@ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out 
     Recvd            1  integers on proc 1
    Data on proc 1: 1
     done           1
     Running on            2  procs
     Allocating            1  elements on rank 0
    Data on proc 0: 1
     done           0
    ijb@ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out 
     Running on            2  procs
     Allocating            3  elements on rank 0
    Data on proc 0: 1 2 3
     done           0
     Recvd            3  integers on proc 1
    Data on proc 1: 1 2 3
     done           1
    ijb@ijb-Latitude-5410:~/work/stack$