research/dns-hit3d-fdm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

pipeline td solve, distinct tag for each rhs

Browse source
This commit is contained in:
ignis 2017-11-12 00:45:40 +09:00
parent 4a8a67d241
commit f5b0550436
1 changed files with 42 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
m_compact.f90
View file

@ -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