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
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$