@@ -6,7 +6,7 @@ program mpi_pass
6
6
7
7
use , intrinsic :: iso_fortran_env, only: compiler_version, int64, stderr= >error_unit
8
8
9
- use mpi_f08
9
+ use mpi
10
10
11
11
implicit none
12
12
@@ -15,7 +15,8 @@ program mpi_pass
15
15
integer :: dest, i, num_procs, id, tag
16
16
integer (int64) :: tic, toc, rate
17
17
18
- type (MPI_STATUS) :: status
18
+ ! type(MPI_STATUS) :: status
19
+ integer :: status (MPI_STATUS_SIZE)
19
20
20
21
call system_clock (tic)
21
22
@@ -43,11 +44,13 @@ program mpi_pass
43
44
select case (id)
44
45
case (0 )
45
46
print * , id, " waiting for MPI_send() from image 1"
46
- call MPI_Recv (val, size (val), MPI_REAL, MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, status)
47
+ call MPI_Recv (val, size (val), MPI_REAL, MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, status, ierr)
48
+ if (ierr /= MPI_SUCCESS) error stop " MPI_Recv failed"
47
49
48
- print ' (i0,a,i0,a,i0)' , id, ' Got data from processor ' , status% MPI_SOURCE, ' tag ' ,status% MPI_TAG
50
+ ! print '(i0,a,i0,a,i0)', id, ' Got data from processor ', status%MPI_SOURCE, ' tag ',status%MPI_TAG
49
51
50
- call MPI_Get_count(status, MPI_REAL, mcount)
52
+ call MPI_Get_count(status, MPI_REAL, mcount, ierr)
53
+ if (ierr /= MPI_SUCCESS) error stop " MPI_Get_count failed"
51
54
52
55
print ' (i0,a,i0,a)' , id, ' Got ' , mcount, ' elements.'
53
56
@@ -61,7 +64,9 @@ program mpi_pass
61
64
62
65
dest = 0
63
66
tag = 55
64
- call MPI_Send(dat, size (dat), MPI_REAL, dest, tag, MPI_COMM_WORLD)
67
+ call MPI_Send(dat, size (dat), MPI_REAL, dest, tag, MPI_COMM_WORLD, ierr)
68
+ if (ierr /= MPI_SUCCESS) error stop " MPI_Send failed"
69
+
65
70
case default
66
71
print ' (i0,a,i0)' , id, ' : MPI has no work for image' , id
67
72
end select
0 commit comments