How to pass information to the main process using MPI PUT? - parallel-processing

Question

I want to pass information to the main process using MPI PUT, but I get an error that the process exits without finalize.
For example, the error for two processes looks like this:
job aborted:
[ranks] message
[0] terminated
[1] process exited without calling finalize
How I can put my value 's' to main process? Can I do it with function MPI ACCUMULATE?
I want to get the modified s variable in the main process. What would the code look like if I wanted to calculate the sum of all received variables from all processes?
integer :: process_Rank, size_Of_Cluster, ierror = 0, win, s = 1
call MPI_INIT(ierror)
call MPI_COMM_SIZE(MPI_COMM_WORLD, size_Of_Cluster, ierror)
call MPI_COMM_RANK(MPI_COMM_WORLD, process_Rank, ierror)
!create windows
if(process_Rank == 0) then
call MPI_WIN_CREATE(s, sizeof(s), 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
else
call MPI_WIN_CREATE(0, 0, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
end if
print *, process_Rank, ' create window'
CALL MPI_Win_fence(0,win,ierror)
!get s from main process (rank = 0)
if(process_Rank <> 0) then
CALL MPI_Get(s, sizeof(s) , MPI_INT, 0, 0, 20, MPI_INT, win, ierror)
print *, process_Rank, ' get data and s = ', s
end if
CALL MPI_Win_fence(0,win,ierror)
if(process_Rank <> 0) then
s = s + process_Rank
print *, process_Rank, ' s = ', s
CALL MPI_PUT(s, sizeof(s), MPI_INT, 0 , 1 , 1, MPI_INT, win, ierror)
end if
print *, 'result s = ', s
CALL MPI_Win_fence(0, win,ierror)
CALL MPI_WIN_FREE(win, ierror)
call MPI_FINALIZE(ierror)

Answer 1

I'm sorry, but there was a lot wrong with your code and I don't have time to explain it all now, but below is a very quickly hacked together version that I think works - the main errors were incorrect kinds for actual arguments of MPI routines, and use of non-standard features (sizeof, <> [does that really work?], MPI_INT, maybe others). Please study it and try to work out why it works and yours does not, I shall try to come back and put in a longer explanation at some point. But if you learn nothing else stop using Include 'mpif.h' and start using the module as I have - this immediately caught one of your more serious errors, namely the wrong kind of integers for the displacement arguments in a number of calls.
If you are learning I would also recommend against the Portland Group compiler. My experiences with it over the years have not been good. Try and use a recent version of gfortran or the Intel or NAG compilers instead.
Program onesided
Use mpi
Implicit None
integer :: process_Rank, size_Of_Cluster, ierror = 0, win, s = 1, size_s
Call mpi_sizeof( s, size_s, ierror )
call MPI_INIT(ierror)
call MPI_COMM_SIZE(MPI_COMM_WORLD, size_Of_Cluster, ierror)
call MPI_COMM_RANK(MPI_COMM_WORLD, process_Rank, ierror)
!create windows
if(process_Rank == 0) then
call MPI_WIN_CREATE(s, Int( size_s, mpi_address_kind ), 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
else
call MPI_WIN_CREATE(0, 0_mpi_address_kind, 1, MPI_INFO_NULL, MPI_COMM_WORLD, win, ierror)
end if
print *, process_Rank, ' create window'
CALL MPI_Win_fence(0,win,ierror)
!get s from main process (rank = 0)
if(process_Rank /= 0) then
CALL MPI_Get(s, 1, MPI_INTEGER, &
0, 0_mpi_address_kind, 1, MPI_INTEGER, win, ierror)
print *, process_Rank, ' get data and s = ', s
end if
CALL MPI_Win_fence(0,win,ierror)
if(process_Rank /= 0) then
s = s + process_Rank
print *, process_Rank, ' s = ', s
CALL MPI_PUT(s, 1, MPI_INTEGER, 0 , 0_mpi_address_kind, 1, MPI_INTEGER, win, ierror)
end if
print *, 'result s = ', s
CALL MPI_Win_fence(0, win,ierror)
CALL MPI_WIN_FREE(win, ierror)
call MPI_FINALIZE(ierror)
End Program onesided
ijb#ijb-Latitude-5410:~/work/stack$ mpif90 --version
GNU Fortran (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.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 -Wall -Wextra -fcheck=all -O -g -std=f2018 one_side.f90
ijb#ijb-Latitude-5410:~/work/stack$ mpirun -np 2 ./a.out
0 create window
result s = 1
1 create window
1 get data and s = 1
1 s = 2
result s = 2