From f5b055043675bae30f1f3e15917c929dd67f2b22 Mon Sep 17 00:00:00 2001 From: ignis Date: Sun, 12 Nov 2017 00:45:40 +0900 Subject: [PATCH] pipeline td solve, distinct tag for each rhs --- m_compact.f90 | 81 ++++++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 39 deletions(-) diff --git a/m_compact.f90 b/m_compact.f90 index 3b789bf..a58baad 100644 --- a/m_compact.f90 +++ b/m_compact.f90 @@ -206,6 +206,8 @@ integer (kind=MPI_INTEGER_KIND),dimension(4) :: requests logical :: recvLow, recvUpp + integer (kind=MPI_INTEGER_KIND), parameter :: rhstag = 0 + h1=1./h r1=7./3. r2=1./12. @@ -213,44 +215,44 @@ !if (myid.eq.0) write(*,*) "parallel dfp commuication" if (myid.eq.master) then - call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, myid, & + call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(1), mpi_err) - call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, numprocs-1, myid, & + call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, numprocs-1, rhstag, & MPI_COMM_TASK, requests(2), mpi_err) - call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, numprocs-1, numprocs-1, & + call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, numprocs-1, rhstag, & MPI_COMM_TASK, requests(3), mpi_err) - call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, myid+1, & + call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(4), mpi_err) elseif (myid.eq.numprocs-1) then - call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, 0, myid, & + call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, 0, rhstag, & MPI_COMM_TASK, requests(1), mpi_err) - call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, myid, & + call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(2), mpi_err) - call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, myid-1, & + call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(3), mpi_err) - call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, 0, 0, & + call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, 0, rhstag, & MPI_COMM_TASK, requests(4), mpi_err) else - call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, myid, & + call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(1), mpi_err) - call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, myid, & + call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(2), mpi_err) - call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, myid-1, & + call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(3), mpi_err) - call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, myid+1, & + call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(4), mpi_err) endif @@ -316,6 +318,8 @@ integer (kind=MPI_INTEGER_KIND),dimension(4) :: requests logical :: recvLow, recvUpp + integer (kind=MPI_INTEGER_KIND), parameter :: rhstag = 0 + h2=1./(h*h) r1=6. r2=3./8. @@ -323,44 +327,44 @@ !if (myid.eq.0) write(*,*) "parallel d2fp commuication" if (myid.eq.master) then - call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, myid, & + call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(1), mpi_err) - call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, numprocs-1, myid, & + call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, numprocs-1, rhstag, & MPI_COMM_TASK, requests(2), mpi_err) - call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, numprocs-1, numprocs-1, & + call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, numprocs-1, rhstag, & MPI_COMM_TASK, requests(3), mpi_err) - call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, myid+1, & + call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(4), mpi_err) elseif (myid.eq.numprocs-1) then - call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, 0, myid, & + call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, 0, rhstag, & MPI_COMM_TASK, requests(1), mpi_err) - call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, myid, & + call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(2), mpi_err) - call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, myid-1, & + call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(3), mpi_err) - call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, 0, 0, & + call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, 0, rhstag, & MPI_COMM_TASK, requests(4), mpi_err) else - call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, myid, & + call MPI_SEND_INIT (x(1,n-1), 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(1), mpi_err) - call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, myid, & + call MPI_SEND_INIT (x(1,1), 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(2), mpi_err) - call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, myid-1, & + call MPI_RECV_INIT (xl, 2*nd, MPI_REAL8, myid-1, rhstag, & MPI_COMM_TASK, requests(3), mpi_err) - call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, myid+1, & + call MPI_RECV_INIT (xu, 2*nd, MPI_REAL8, myid+1, rhstag, & MPI_COMM_TASK, requests(4), mpi_err) endif @@ -620,6 +624,7 @@ SUBROUTINE ctdslv(r,va,za,nd,n,nall) INTEGER,PARAMETER :: nb = 256 + INTEGER,PARAMETER :: nb2 = 64 INTEGER,INTENT(IN) :: n,nd,nall REAL*8,INTENT(INOUT),DIMENSION(nd,n) :: r REAL*8,INTENT(IN),DIMENSION(nall) :: va @@ -627,14 +632,12 @@ REAL*8,DIMENSION(n) :: v,z INTEGER i,j INTEGER ii,jj - REAL*8, DIMENSION(nd) :: sum - REAL*8, DIMENSION(nd) :: x1, x1_ + REAL*8, DIMENSION(nd) :: x1, x0 INTEGER npart, nbase, nlow, nupp INTEGER :: pid, np - REAL*8, DIMENSION(nb) :: r0, r1, sum0 - REAL*8, DIMENSION(nb,2) :: buf + REAL*8, DIMENSION(nb) :: r0, r1 pid = myid np = numprocs @@ -652,13 +655,13 @@ endif x1 = 0.0 - x1_ = 0.0 + x0 = 0.0 do i=1,n - x1_ = x1_ + z(i)*r(:,i) + x0 = x0 + z(i)*r(:,i) enddo - call MPI_REDUCE(x1_, x1, nd, MPI_REAL8, MPI_SUM, master, MPI_COMM_TASK, mpi_err) + call MPI_REDUCE(x0, x1, nd, MPI_REAL8, MPI_SUM, master, MPI_COMM_TASK, mpi_err) ! first process if (myid.eq.0) then @@ -696,13 +699,13 @@ ENDDO r0 = r(jj:jj+nb-1,n) - CALL MPI_SEND(r0, nb, MPI_REAL8, pid+1, 1, MPI_COMM_TASK, mpi_err) + CALL MPI_SEND(r0, nb, MPI_REAL8, pid+1, jj, MPI_COMM_TASK, mpi_err) ENDDO DO jj=1,nd,nb - CALL MPI_RECV(r1, nb, MPI_REAL8, pid+1, 2, MPI_COMM_TASK, mpi_status, mpi_err) + CALL MPI_RECV(r1, nb, MPI_REAL8, pid+1, nd+jj, MPI_COMM_TASK, mpi_status, mpi_err) i=n DO j=jj,jj+nb-1 @@ -722,7 +725,7 @@ DO jj=1,nd,nb - CALL MPI_RECV(r1, nb, MPI_REAL8, pid-1, 1, MPI_COMM_TASK, mpi_status, mpi_err) + CALL MPI_RECV(r1, nb, MPI_REAL8, pid-1, jj, MPI_COMM_TASK, mpi_status, mpi_err) i=1 DO j=jj,jj+nb-1 @@ -746,7 +749,7 @@ ENDDO r0 = r(jj:jj+nb-1,1) - CALL MPI_SEND(r0, nb, MPI_REAL8, pid-1, 2, MPI_COMM_TASK, mpi_err) + CALL MPI_SEND(r0, nb, MPI_REAL8, pid-1, nd+jj, MPI_COMM_TASK, mpi_err) ENDDO @@ -755,7 +758,7 @@ DO jj=1,nd,nb - CALL MPI_RECV(r1, nb, MPI_REAL8, pid-1, 1, MPI_COMM_TASK, mpi_status, mpi_err) + CALL MPI_RECV(r1, nb, MPI_REAL8, pid-1, jj, MPI_COMM_TASK, mpi_status, mpi_err) i=1 DO j=jj,jj+nb-1 @@ -769,13 +772,13 @@ ENDDO r0 = r(jj:jj+nb-1,n) - CALL MPI_SEND(r0, nb, MPI_REAL8, pid+1, 1, MPI_COMM_TASK, mpi_err) + CALL MPI_SEND(r0, nb, MPI_REAL8, pid+1, jj, MPI_COMM_TASK, mpi_err) ENDDO DO jj=1,nd,nb - CALL MPI_RECV(r1, nb, MPI_REAL8, pid+1, 2, MPI_COMM_TASK, mpi_status, mpi_err) + CALL MPI_RECV(r1, nb, MPI_REAL8, pid+1, nd+jj, MPI_COMM_TASK, mpi_status, mpi_err) i=n DO j=jj,jj+nb-1 @@ -789,7 +792,7 @@ ENDDO r0 = r(jj:jj+nb-1,1) - CALL MPI_SEND(r0, nb, MPI_REAL8, pid-1, 2, MPI_COMM_TASK, mpi_err) + CALL MPI_SEND(r0, nb, MPI_REAL8, pid-1, nd+jj, MPI_COMM_TASK, mpi_err) ENDDO