How to send and receive data in a loop - fortran

Question

I am facing a problem in sending and receiving data in a do loop. Check the code below:
include 'mpif.h'
parameter (NRA = 4)
parameter (NCA = 4)
parameter (MASTER = 0)
parameter (FROM_MASTER = 1)
parameter (FROM_WORKER = 2)
integer numtasks,taskid,numworkers,source,dest,mtype,
& cols,avecol,extra, offset,i,j,k,ierr,rc
integer status(MPI_STATUS_SIZE)
real*8 a(NRA,NCA)
call MPI_INIT( ierr )
call MPI_COMM_RANK( MPI_COMM_WORLD, taskid, ierr )
call MPI_COMM_SIZE( MPI_COMM_WORLD, numtasks, ierr )
numworkers = numtasks-1
print *, 'task ID= ',taskid
C *************************** master task *************************************
if (taskid .eq. MASTER) then
if (numworkers .NE. 2) then
print *, 'Please use 3 processors'
print *,'Quitting...'
call MPI_ABORT(MPI_COMM_WORLD,rc,ierr)
endif
C Initialize A and B
do 30 i=1, NRA
do 30 j=1, NCA
a(i,j) = (i-1)+(j-1)
30 continue
C Send matrix data to the worker tasks
avecol = NCA/numworkers
extra = mod(NCA,numworkers)
offset = 1
mtype = FROM_MASTER
do 50 dest=1, numworkers
if (dest .le. extra) then
cols = avecol + 1
else
cols = avecol
endif
write(*,*)' sending',cols,' cols to task',dest
call MPI_SEND(offset,1,MPI_INTEGER,dest,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(cols,1,MPI_INTEGER,dest,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(a(1,offset),cols*NRA,MPI_DOUBLE_PRECISION,
& dest,mtype,MPI_COMM_WORLD,ierr )
offset = offset + cols
50 continue
C Receive results from worker tasks
mtype = FROM_WORKER
do 60 i=1, numworkers
source = i
call MPI_RECV(offset,1,MPI_INTEGER,source,
& mtype,MPI_COMM_WORLD,status,ierr )
call MPI_RECV(cols,1,MPI_INTEGER,source,
& mtype,MPI_COMM_WORLD,status,ierr )
call MPI_RECV(a(1,offset),cols*NRA,MPI_DOUBLE_PRECISION,
& source,mtype,MPI_COMM_WORLD,status,ierr)
60 continue
C Print results
do 90 i=1, NRA
do 80 j = 1, NCA
write(*,70)a(i,j)
70 format(2x,f8.2,$)
80 continue
print *, ' '
90 continue
endif
C *************************** worker task *************************************
if (taskid > MASTER) then
C Receive matrix data from master task
mtype = FROM_MASTER
call MPI_RECV(offset,1,MPI_INTEGER,MASTER,
& mtype,MPI_COMM_WORLD,status,ierr)
call MPI_RECV( cols,1,MPI_INTEGER,MASTER,
& mtype,MPI_COMM_WORLD,status,ierr)
call MPI_RECV(a(1,offset),cols*NCA,MPI_DOUBLE_PRECISION,MASTER,
& mtype,MPI_COMM_WORLD,status,ierr)
start0 = offset
end0 = offset+cols-1
C Do matrix multiply
do t=1,5
do i=1, NRA
do j=start0,end0
a(i,j) = a(i,j)*t
enddo
enddo
C Send results back to master task
mtype = FROM_WORKER
call MPI_SEND(offset,1,MPI_INTEGER,MASTER,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(cols,1,MPI_INTEGER,MASTER,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(a(1,offset),cols*NCA,MPI_DOUBLE_PRECISION,MASTER,
& mtype,MPI_COMM_WORLD,ierr)
enddo
endif
call MPI_FINALIZE(ierr)
end
I want to print matrix a, every time on the screen which is inside the do loop. When I execute the code, it gets printed for only once, i.e. for the first time of the do loop (t=1). How to modify this code, so that I can get the matrix a printed every time on the screen once it gets calculated.

Answer 1

I got it. I have to put a loop at the master while receiving the data from slave. The modified code.
include 'mpif.h'
parameter (NRA = 4)
parameter (NCA = 4)
parameter (MASTER = 0)
parameter (FROM_MASTER = 1)
parameter (FROM_WORKER = 2)
integer numtasks,taskid,numworkers,source,dest,mtype,
& cols,avecol,extra, offset,i,j,k,ierr,rc
integer status(MPI_STATUS_SIZE)
real*8 a(NRA,NCA)
call MPI_INIT( ierr )
call MPI_COMM_RANK( MPI_COMM_WORLD, taskid, ierr )
call MPI_COMM_SIZE( MPI_COMM_WORLD, numtasks, ierr )
numworkers = numtasks-1
print *, 'task ID= ',taskid
C *************************** master task *************************************
if (taskid .eq. MASTER) then
if (numworkers .NE. 2) then
print *, 'Please use 3 processors'
print *,'Quitting...'
call MPI_ABORT(MPI_COMM_WORLD,rc,ierr)
endif
C Initialize A and B
do 30 i=1, NRA
do 30 j=1, NCA
a(i,j) = (i-1)+(j-1)
30 continue
C Send matrix data to the worker tasks
avecol = NCA/numworkers
extra = mod(NCA,numworkers)
offset = 1
mtype = FROM_MASTER
do 50 dest=1, numworkers
if (dest .le. extra) then
cols = avecol + 1
else
cols = avecol
endif
write(*,*)' sending',cols,' cols to task',dest
call MPI_SEND(offset,1,MPI_INTEGER,dest,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(cols,1,MPI_INTEGER,dest,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(a(1,offset),cols*NRA,MPI_DOUBLE_PRECISION,
& dest,mtype,MPI_COMM_WORLD,ierr )
offset = offset + cols
50 continue
C Receive results from worker tasks
do t = 1,5
mtype = FROM_WORKER
do 60 i=1, numworkers
source = i
call MPI_RECV(offset,1,MPI_INTEGER,source,
& mtype,MPI_COMM_WORLD,status,ierr )
call MPI_RECV(cols,1,MPI_INTEGER,source,
& mtype,MPI_COMM_WORLD,status,ierr )
call MPI_RECV(a(1,offset),cols*NRA,MPI_DOUBLE_PRECISION,
& source,mtype,MPI_COMM_WORLD,status,ierr)
60 continue
C Print results
do 90 i=1, NRA
do 80 j = 1, NCA
write(*,70)a(i,j)
70 format(2x,f8.2,$)
80 continue
print *, ' '
90 continue
end do
endif
C *************************** worker task *************************************
if (taskid > MASTER) then
C Receive matrix data from master task
mtype = FROM_MASTER
call MPI_RECV(offset,1,MPI_INTEGER,MASTER,
& mtype,MPI_COMM_WORLD,status,ierr)
call MPI_RECV( cols,1,MPI_INTEGER,MASTER,
& mtype,MPI_COMM_WORLD,status,ierr)
call MPI_RECV(a(1,offset),cols*NCA,MPI_DOUBLE_PRECISION,MASTER,
& mtype,MPI_COMM_WORLD,status,ierr)
start0 = offset
end0 = offset+cols-1
C Do matrix multiply
do t=1,5
do i=1, NRA
do j=start0,end0
a(i,j) = a(i,j)*t
enddo
enddo
C Send results back to master task
mtype = FROM_WORKER
call MPI_SEND(offset,1,MPI_INTEGER,MASTER,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(cols,1,MPI_INTEGER,MASTER,mtype,
& MPI_COMM_WORLD,ierr)
call MPI_SEND(a(1,offset),cols*NCA,MPI_DOUBLE_PRECISION,MASTER,
& mtype,MPI_COMM_WORLD,ierr)
enddo
endif
call MPI_FINALIZE(ierr)
end