CODEWITHSUNDEEP
parallel-processingfortranmpi
Alevtina
Alevtina

Reputation: 145

How to pass information to the main process using MPI PUT?

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)

Upvotes: 0

Views: 193

Answers (1)

Ian Bush
Ian Bush

Reputation: 7433

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

Upvotes: 3

Related Questions