Microsoft PowerPoint - KN002.ppt

Transcription

1 MPI II MPI MPI MPI-110 MPI- SPMD Single Program/Instruction Multiple Data CPU 4

2 PE: Processing Element PE #0 Program Data #0 PE #1 Program Data #1 SPMD mpirun -np M <Program> PE # Program Data # MPI 9 PE #M-1 Program Data #M-1 CPU MPI 1 PEProcessing Element PE SPMDMD PE MPIPE0 8PE SPMDSingle Program Multiple Data 8 SPMDSingle Program Multiple Data CPU

3 9 10 SPMD SPMD1/ SPMD PE #0 PE #1 PE # PE #3 NG(=0)VG Program Program Program Program integer, parameter :: NG= 0 real(kind=8), dimension(0) :: VG Data #0 Data #1 Data # Data #3 do i= 1, NG VG(i)=.0 * VG(i) 4 0/4= 11 1 SPMD/ integer, parameter :: NL= real(kind=8), dimension() :: VL do i= 1, NL VL(i)=.0 * VL(i) Single Program VLMultiple Data VL CPU VG 10Global Data VL PE 1Local Data

4 13 14 VG 10PE 6~101PE 111PE 1603PE VL1 1 VG( 1) VG( ) VG( 3) VG( 4) VG( ) VG( 6) VG( 7) VG( 8) VG( 9) VG(10) VG(11) VG(1) VG(13) VG(14) VG(1) VG(16) VG(17) VG(18) VG(19) VG(0) PE# VL(1) VL() VL(3) VL(4) VL() VL(1) VL() VL(3) VL(4) VL() VL(1) VL() VL(3) VL(4) VL() VL(1) VL() VL(3) VL(4) VL() VG VL 10Global Data 1Local Data VGVL VGVLVLVG VL 1 16 MPI Collective Communication MPI_Reduce, MPI_Scatter/Gather 11Point-to-Point MPI_Send, MPI_Receive PE#

5 PE d d BF 0, 0@ x 0, 0@ x x dx dx 1 BF x BF xmax x max BF =0 NG=164PEPE NL=16/4=4 19 NG=16, PE#= BF =0

6 NG=16, PE#= PE# PE# A ( i) ( i 1) A L 1 AL ( i) x, A D D ( i) ( i) A ( i) ( i 1) BF( i) 1 ( i), A ( i) R x x R D PE 4 PE# PE# PE#

7 111D PE# MPI_SEND MPI_RECV blocking dead lock RECVSEND securempi 6 MPI_SEND/MPI_RECV 7 MPI_SEND/MPI_RECV if (my_rank.eq.0) NEIB_ID=1 if (my_rank.eq.1) NEIB_ID=0 call MPI_SEND (NEIB_ID, arg s) call MPI_RECV (NEIB_ID, arg s) if (my_rank.eq.0) NEIB_ID=1 if (my_rank.eq.1) NEIB_ID=0 if (my_rank.eq.0) then call MPI_SEND (NEIB_ID, arg s) call MPI_RECV (NEIB_ID, arg s) if (my_rank.eq.1) then call MPI_RECV (NEIB_ID, arg s) call MPI_SEND (NEIB_ID, arg s) MPI_SEND/MPI_RECV cenjuok

8 MPI_ISEND MPI_IRECV non-blocking MPI_WAITALL MPI_SENDRECV if (my_rank.eq.0) NEIB_ID=1 if (my_rank.eq.1) NEIB_ID=0 call MPI_ISEND (NEIB_ID, arg s) call MPI_IRECV (NEIB_ID, arg s) call MPI_WAITALL (for IRECV) call MPI_WAITALL (for ISEND) ISENDIRECV WAITALL OK MPI_ISEND sendbufcounttag destmpi_waitall call MPI_ISEND (sendbuf,count,datatype,dest,tag,comm,request, ierr) sendbuf I count I datatype I dest I tag I 0 comm I request O MPI_WAITALL MPI_ISEND :C ierr O 31 3 request handle request call MPI_ISEND (sendbuf,count,datatype,dest,tag,comm,request, ierr) sendbuf I count I datatype I dest I tag I 0 comm I request O MPI_WAITALL MPI_ISEND ierr O C allocate (request(neibpetot)) MPI_IRECV recvbufcounttag destmpi_waitall call MPI_IRECV (recvbuf,count,datatype,dest,tag,comm,request, ierr) recvbuf I count I datatype I dest I tag I 0 comm I request O MPI_WAITALL MPI_IRECV C ierr O

9 MPI_WAITALL 11MPI_ISENDMPI_IRECV MPI_WAITALL MPI_WAITALL MPI_ISENDMPI_IRECV MPI_ISEND/IRECV MPI_BARRIER requeststatus MPI_ISEND/IRECV call MPI_WAITALL (count,request,status,ierr) count I MPI_ISEND MPI_RECV request I/O MPI_ISENDMPI_IRECV count status O MPI_STATUS_SIZE,count MPI_STATUS_SIZE mpif.h, mpi.h C ierr O 33 status object status call MPI_WAITALL (count,request,status,ierr) count I MPI_ISEND MPI_RECV request I/O MPI_ISENDMPI_IRECV count status O MPI_STATUS_SIZE,count MPI_STATUS_SIZE mpif.h, mpi.h ierr O C allocate (stat(mpi_status_size,neibpetot)) 34 MPI_SENDRECV MPI_SEND+MPI_RECV call MPI_SENDRECV (sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, recvcount,recvtype,source,recvtag,comm,status,ierr) sendbuf I sendcount I sendtype I dest I sendtag I 0 recvbuf I recvcount I recvtype I source I sendtag I 0 comm I status O MPI_STATUS_SIZE MPI_STATUS_SIZE mpif.h C ierr O 3 FORTRAN MPI_Isend: request MPI_Irecv: request MPI_Waitall: request, status integer request(neibpetot) integer status (MPI_STAUTS_SIZE,NEIBPETOT) MPI_Sendrecv: status integer status (MPI_STATUS_SIZE) 36

10 C MPI_Isend: request MPI_Irecv: request MPI_Waitall: request, status MPI_Status *StatSend, *StatRecv; MPI_Request *RequestSend, *RequestRecv; StatSend = malloc(sizeof(mpi_status) * NEIBpetot); StatRecv = malloc(sizeof(mpi_status) * NEIBpetot); RequestSend = malloc(sizeof(mpi_request) * NEIBpetot); RequestRecv = malloc(sizeof(mpi_request) * NEIBpetot); MPI_Sendrecv: status MPI_Status *Status; Status = malloc(sizeof(mpi_status)); 37 1/ NG=16 NG= PE# 38 / 39 3/ 40 N=4 PE# N+1= PE# A ( i) A ( i) A ( i) L i1 D i1 BF( i) 1 1 AL ( i), A ( i), A ( i) D R x x x i R (1 i N)

11 41 4 4/ i=1~n Interior/Internal Points 4/ i=1~n Interior/Internal Points i=0, N+1Exterior/External Points i=0i=n A ( i) A ( i) A ( i) L i1 D i1 BF( i) 1 1 AL ( i), A ( i), A ( i) D R x x x i R PE# (1 i N) A ( i) A ( i) A ( i) L i1 D i1 BF( i) 1 1 AL ( i), A ( i), A ( i) D R x x x i R PE# (1 i N) / i=1~n Interior/Internal Points i=0, N+1Exterior/External Points i=0i=n+1 Boundary Points i1 1 3 A ( i) A ( i) A ( i) L D i1 1 1 AL ( i), A ( i), A ( i) D R x x x i R BF( i) PE# (1 i N) / 11 send recv

12 PE#

13 1/ 49 x y f N 0 E C W N C S x y f C y C W E x x y S PE#

14 PE# PE# N y C W E x x y S PE# PE#

15 PE# PE# /4 Internal Points /4 Internal Points External Points

16 /4 Internal Points External Points Boundary Points /4 Internal Points External Points Boundary Points import export NEIBPETOTNEIBPE(neib) export_index(neib), neib= 0, NEIBPETOT export_item(k), k= 1, export_index(neibpetot) SENDbuf(k), k= 1, export_index(neibpetot)

17 6 66 NEIBPETOTNEIBPE(neib) import_index(neib), neib= 0, NEIBPETOT import_item(k), k= 1, import_index(neibpetot) RECVbuf(k), k= 1, import_index(neibpetot) 1/ #NEIBPEtot #NEIBPE 1 3 #NODE 4 16 #IMPORT_index 4 8 #IMPORT_items #EXPORT_index 4 8 #EXPORT_items / #NEIBPEtot #NEIBPE 1 3 #NODE 4 16 #IMPORT_index 4 8 #IMPORT_items #EXPORT_index 4 8 #EXPORT_items / #NEIBPEtot #NEIBPE 1 3 #NODE 4 16 #IMPORT_index 4 8 #IMPORT_items #141~4 #34~8 import #EXPORT_index 4 8 #EXPORT_items

18 / #NEIBPEtot #NEIBPE 1 3 #NODE 4 16 #IMPORT_index 4 8 #IMPORT_items #EXPORT_index 4 8 #EXPORT_items #1 import1~4 #3 import~8 / #NEIBPEtot #NEIBPE 1 3 #NODE 4 16 #IMPORT_index 4 8 #IMPORT_items #141~4 1 #34~8 export 3 4 #EXPORT_index 4 8 #EXPORT_items / #NEIBPEtot #NEIBPE 1 3 #NODE 4 16 #IMPORT_index 4 8 #IMPORT_items #EXPORT_index 4 8 #EXPORT_items #1 export1~4 #3 export~8 6/

19 MPI_Isend/Irecv/Waitall 73 MPI_Sendrecv 74 SENDbuf neib#1 neib# neib#3 neib#4 SENDbuf neib#1 neib# neib#3 neib#4 BUFlength_e BUFlength_e BUFlength_e BUFlength_e export_index(0)+1 export_index(1)+1 export_index()+1 export_index(3)+1 export_index(4) BUFlength_e BUFlength_e BUFlength_e BUFlength_e export_index(0)+1 export_index(1)+1 export_index()+1 export_index(3)+1 export_index(4) do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= VAL(kk) is_e= export_index(neib-1) + 1 ie_e= export_index(neib ) BUFlength_e= ie_e is_e call MPI_ISEND (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) call MPI_WAITALL (NEIBPETOT, request_send, stat_recv, ierr) do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= VAL(kk) is_e= export_index(neib-1) + 1 ie_e= export_index(neib ) BUFlength_e= ie_e is_e call MPI_SENDRECV (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, stat_sr, ierr) MPI_Isend/Irecv/Waitall 7 MPI_Sendrecv 76 is_i= import_index(neib-1) + 1 ie_i= import_index(neib ) BUFlength_i= ie_i is_i is_i= import_index(neib-1) + 1 ie_i= import_index(neib ) BUFlength_i= ie_i is_i call MPI_IRECV (RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) VAL(kk)= RECVbuf(k) call MPI_SENDRECV (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, stat_sr, ierr) do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) VAL(kk)= RECVbuf(k) RECVbuf neib#1 neib# neib#3 neib#4 RECVbuf neib#1 neib# neib#3 neib#4 BUFlength_i BUFlength_i BUFlength_i BUFlength_i import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4) BUFlength_i BUFlength_i BUFlength_i BUFlength_i import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4)

20 -- PREPARE send buffer do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= BUF(kk) -- SEND is = export_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) call MPI_ISEND (SENDbuf(is), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) RECV ir = import_index(neib-1) + 1 len_r= import_index(neib) - import_index(neib-1) call MPI_IRECV (RECVbuf(ir), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) -- WAITall for RECV call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) -- update array do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) 78 SENDbuf neib#1 neib# neib#3 neib#4 RECVbuf neib#1 neib# neib#3 neib#4 export_index(0)+1 len_s len_s len_s len_s export_index(1)+1 export_index()+1 export_index(3)+1 export_index(4) len_r len_r len_r len_r import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4) SEND === call MPI_ISEND (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) === is_e= export_index(neib-1) + 1 ie_e= export_index(neib ) BUFlength_e= ie_e is_e call MPI_ISEND (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) RECV === PE# call MPI_IRECV (RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) === PE#PE# PE# IRECVPENEIBPE(neib)ISEND len_slen_r NEIBPE(neib) is_i= import_index(neib-1) + 1 ie_i= import_index(neib ) BUFlength_i= ie_i is_i call MPI_IRECV (RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr)! NEIBPEneib

21 #0#3 #1 #3 #1 81 #PE0 send: SENDbuf(iS_e)~ SENDbuf(iE_e+BUFlength_e-1) : #PE1 send: SENDbuf(iS_e)~ SENDbuf(iE_e+BUFlength_e-1) 8 Send #0 # #9 #0 #10 Recv.. #3 #PE0 recv: RECVbuf(iS_i)~ RECVbuf(iE_i+Buflength_i-1) #PE1 recv: RECVbuf(iS_i)~ RECVbuf(iE_i+Buflength_i-1) NEIBPE(:)=1,3,,9 NEIBPE(:)=1,0,10! NEIBPEneib length_sendlength_recv SENDbufRECVbuf SENDbufRECVbuf BUF BUF SEND === call MPI_ISEND (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) === RECV === call MPI_IRECV (RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) === SEND === if (neib.eq.1) then ikk= 1 else ikk= N if (my_rank.eq.0.and. neib.eq.1) then ikk= N call MPI_ISEND (BUF(ikk), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) ===

22 PE# is_e= export_index(neib-1) + 1 ie_e= export_index(neib ) BUFlength_e= ie_e is_e call MPI_ISEND (VAL(...), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) MPI i=1~n Interior/Internal Points i=1~n Interior/Internal Points i=n+1, N+Exterior/External Points i=n+1i=n A ( i) A ( i) A ( i) L i1 D i1 BF( i) 1 1 AL ( i), A ( i), A ( i) D R x x x i R PE# (1 i N) A ( i) A ( i) A ( i) L i1 D i1 BF( i) 1 1 AL ( i), A ( i), A ( i) D R x x x i R PE# (1 i N)

23 i=1~n Interior/Internal Points i=n+1, N+Exterior/External Points i=n+1i=n+ Boundary Points PREPARE send buffer do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= BUF(kk) -- SEND is = export_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) call MPI_ISEND (SENDbuf(is), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) 90 i1 A ( i) A ( i) A ( i) L D i1 1 1 AL ( i), A ( i), A ( i) D R x x x i R BF( i) PE# (1 i N) SENDbuf neib#1 neib# neib#3 neib#4 len_s len_s len_s len_s export_index(0)+1 export_index(1)+1 export_index()+1 export_index(3)+1 export_index(4) -- RECV ir = import_index(neib-1) + 1 len_r= import_index(neib) - import_index(neib-1) call MPI_IRECV (RECVbuf(ir), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) 91 1D1/ WAITall for RECV call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) -- update array do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) RECVbuf neib#1 neib# neib#3 neib#4 len_r len_r len_r len_r import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4)

24 D/4 1D3/4 PE PE#(my_rank-1): NEIBPE(1) PE#(my_rank+1): NEIBPE() PE export_index(1)= 1 export_item (1)= 1 export_index()= export_item() = export_index(1)= 1 import_index(1)= 1 export_index()= import_index()= import_index(1)= 1 import_item (1)= import_index()= import_item ()= PE# D4/4 PE PE SENDbuf(1)=BUF(1) BUF()=RECVbuf(1) SENDbuf()=BUF(4) BUF(6)=RECVbuf() NEIBPETOTNEIBPE(neib) SENDbuf(1)=BUF(1) NEIBPETOT=, NEIB(1)= my_rank-1, NEIB()= my_rank+1 export_index(neib), neib= 0, NEIBPETOT export_index(0)=0, export_index(1)= 1, export_index()= export_item(k), k= 1, export_index(neibpetot) export_item(1)= 1, export_item()= N SENDbuf()=BUF(4) PE# SENDbuf(k), k= 1, export_index(neibpetot) SENDbuf(1)= BUF(1), SENDbuf()= BUF(N)

25 : NEIBPETOTNEIBPE(neib) BUF()=RECVbuf(1) NEIBPETOT=, NEIB(1)= my_rank-1, NEIB()= my_rank+1 BUF(6)=RECVbuf() import_index(neib), neib= 0, NEIBPETOT import_index(0)=0, import_index(1)= 1, import_index()= import_item(k), k= 1, import_index(neibpetot) import_item(1)= N+1, import_item()= N+ RECVbuf(k), k= 1, import_index(neibpetot) BUF(N+1)=RECVbuf(1), BUF(N+)=RECVbuf() SENDbuf(1)=BUF(1) SENDbuf()=BUF(4) BUF()=RECVbuf(1) BUF(6)=RECVbuf() NEIBPETOT= NEIBPE(1)= my_rank - 1 NEIBPE()= my_rank + 1 import_index(1)= 1 import_index()= import_item (1)= N+1 import_item ()= N+ export_index(1)= 1 export_index()= export_item (1)= 1 export_item ()= N if (my_rank.eq.0) then import_item (1)= N+1 export_item (1)= N NEIBPE(1)= my_rank+1 C 99 / SENDbuf[0]=BUF[0] SENDbuf[1]=BUF[3] BUF[4]=RECVbuf[0] BUF[]=RECVbuf[1] NEIBPETOT= NEIBPE[0]= my_rank - 1 NEIBPE[1]= my_rank + 1 import_index[1]= 0 import_index[]= 1 import_item [0]= N import_item [1]= N+1 export_index[1]= 0 export_index[]= 1 export_item [0]= 0 export_item [1]= N-1 NG= if (my_rank.eq.0) then import_item [0]= N export_item [0]= N-1 NEIBPE[0]= my_rank+1 PE#

26 /3 PE# / PE# PE# PEi=1~N(=4) i=1 101 i= 10 i=3 103 i=4 104 i= i=1 10 i= 106 i=3 107 i=4 108 i= i=6 PE# i=1 109 i= 110 i=3 111 i=4 11 i= i=6 i=1 113 i= 114 i=3 11 i=4 116 i= / PE# FORTRAN $ cd <$1DH>/data $ mpif90 Oss -noparallel 1d-srb1.f $ qsub go.sh $ mpif90 Oss -noparallel 1d-srb.f $ qsub go.sh ISEND/IRECV SENDRECV i=1 101 i= 10 i=3 103 i=4 104 i= 10 i=1 10 i= 106 i=3 107 i=4 108 i= 104 i=6 109 PE# i=1 109 i= 110 i=3 111 i=4 11 i= 108 i=6 113 i=1 113 i= 114 i=3 11 i=4 116 i= 11 C $ cd <$1DH>/data $ mpicc Os -noparallel 1d-srb1.c $ qsub go.sh $ mpicc Os -noparallel 1d-srb.c $ qsub go.sh ISEND/IRECV SENDRECV

27 d-srb1.f /10 : 1d-srb1.f 3/10 PE implicit REAL*8 (A-H,O-Z) include 'mpif.h' integer(kind=4) :: my_rank, PETOT integer(kind=4) :: N, NEIBPETOT, BUFlength integer(kind=4), dimension() :: NEIBPE integer(kind=4), dimension(0:) :: import_index, export_index integer(kind=4), dimension( ) :: import_item, export_item integer(kind=4), dimension() :: SENDbuf, RECVbuf integer(kind=4), dimension(:), allocatable :: BUF integer(kind=4), dimension(:,:), allocatable :: stat_send integer(kind=4), dimension(:,:), allocatable :: stat_recv integer(kind=4), dimension(: ), allocatable :: request_send integer(kind=4), dimension(: ), allocatable :: request_recv INIT. MPI === call MPI_INIT (ierr) call MPI_COMM_SIZE (MPI_COMM_WORLD, PETOT, ierr ) call MPI_COMM_RANK (MPI_COMM_WORLD, my_rank, ierr ) === INIT === N: N= 4 allocate (BUF(N+)) BUF= 0 if (my_rank.eq.0) open (11, file='1d.0', status='unknown') if (my_rank.eq.1) open (11, file='1d.1', status='unknown') if (my_rank.eq.) open (11, file='1d.', status='unknown') if (my_rank.eq.3) open (11, file= 1d.3, status= unknown ) do i= 1, N read (11,*) BUF(i) close (11) PE# : 1d-srb1.f 4/10 istart= 1 iend = N+ if (my_rank.eq.0 ) iend = N+1 if (my_rank.eq.petot-1) iend = N+1 do i= istart, iend write (*,'(a, 3i8)') '%%% before', my_rank, i, BUF(i) 107 : 1d-srb1.f /10 NEIBPETOT= if (my_rank.eq.0 ) NEIBPETOT= 1 if (my_rank.eq.petot-1) NEIBPETOT= 1 if (PETOT.eq.1) NEIBPETOT= 0 NEIBPE(1)= my_rank - 1 NEIBPE()= my_rank + 1 if (my_rank.eq.0 ) NEIBPE(1)= my_rank + 1 if (my_rank.eq.petot-1) NEIBPE(1)= my_rank is= 1 ie= N+1 1 is= 1 ie= N+ PE# is= 1 ie= N+ is= 1 ie= N+1 1 import_index= 0 export_index= 0 import_item = 0 export_item = 0 import_index(1)= 1 import_index()= import_item (1)= N+1 import_item ()= N+ export_index(1)= 1 export_index()= export_item (1)= 1 export_item ()= N if (my_rank.eq.0) then import_item (1)= N+1 export_item (1)= N PENEIBPETOT PENEIBPE PE# BUFlength= 1

28 SENDbuf(1)=BUF(1) BUF()=RECVbuf(1) SENDbuf()=BUF(4) BUF(6)=RECVbuf() NEIBPETOT= NEIBPE(1)= my_rank - 1 NEIBPE()= my_rank + 1 import_index(1)= 1 import_index()= import_item (1)= N+1 import_item ()= N+ export_index(1)= 1 export_index()= export_item (1)= 1 export_item ()= N if (my_rank.eq.0) then import_item (1)= N+1 export_item (1)= N NEIBPE(1)= my_rank : 1d-srb1.f 6/ INIT. arrays for MPI_WAITALL === allocate (stat_send(mpi_status_size,neibpetot)) allocate (stat_recv(mpi_status_size,neibpetot)) allocate (request_send(neibpetot)) allocate (request_recv(neibpetot)) ===!! request handle request_sendrequest_recv status object stat_sendstat_recv MPI_STATUS_SIZE mpif.h mpi.h 110 : 1d-srb1.f 7/ PREPARE send buffer === do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= BUF(kk) === BUF(1)BUF(N) SENDbuf PE#(my_rank-1): NEIBPE(1) PE#(my_rank+1): NEIBPE() 111 : 1d-srb1.f 8/ SEND === is = export_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) call MPI_ISEND (SENDbuf(is), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) === RECV === ir = import_index(neib-1) + 1 len_r= import_index(neib) - import_index(neib-1) call MPI_IRECV (RECVbuf(ir), len_r, MPI_INTEGER, SENDbuf(is)len_s=1 PENEIBPE(neib) NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) === SENDbuf(1)=BUF(1) SENDbuf()=BUF(4) WAITall for RECV === call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) ===

29 : 1d-srb1.f 8/ SEND === is = export_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) call MPI_ISEND (SENDbuf(is), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) === RECV === ir = import_index(neib-1) + 1 len_r= import_index(neib) - import_index(neib-1) call MPI_IRECV (RECVbuf(ir), len_r, MPI_INTEGER, RECVbuf(ir)len_r=1 PENEIBPE(neib) NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) === WAITall for RECV === call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) 113 : 1d-srb1.f 8/ SEND === call MPI_ISEND (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) === RECV === call MPI_IRECV (RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) === RECVbuf WAITall for RECV === call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) === 114 === : 1d-srb1.f 8/ SEND === call MPI_ISEND (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) === 11 : 1d-srb1.f 9/ update array === do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) BUF(N+1) BUF(N+) RECV === call MPI_IRECV (RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) === RECVbuf WAITall for RECV === call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) do i= istart, iend write (*,'(a, 3i8)') '### after', my_rank, i, BUF(i) === PE#(my_rank-1): NEIBPE(1) PE#(my_rank+1): NEIBPE() === BUF()=RECVbuf(1) BUF(6)=RECVbuf()

30 : 1d-srb1.f 10/ update array === do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) 117 : 1d-sr1.f 10/ update array === do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) 118 do i= istart, iend write (*,'(a, 3i8)') '### after', my_rank, i, BUF(i) === do i= istart, iend write (*,'(a, 3i8)') '### after', my_rank, i, BUF(i) === WAITall for SEND === call MPI_WAITALL (NEIBPETOT, request_send, stat_send, ierr) WAITall for SEND === call MPI_WAITALL (NEIBPETOT, request_send, stat_send, ierr) === === SENDbuf : 1d-srb1.f 10/ update array === do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) do i= istart, iend write (*,'(a, 3i8)') '### after', my_rank, i, BUF(i) === WAITall for SEND === call MPI_WAITALL (NEIBPETOT, request_send, stat_send, ierr) === 119 MPI_ISEND/IRECV/WAITALL MPI_SENDRECV 1d-srb1.f: Isend/Irecv/Waitall allocate (stat_send(mpi_status_size,neibpetot)) allocate (stat_recv(mpi_status_size,neibpetot)) allocate (request_send(neibpetot)) allocate (request_recv(neibpetot)) call MPI_ISEND (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) call MPI_IRECV (RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) call MPI_WAITALL (NEIBPETOT, request_send, stat_send, ierr) 1d-srb.f: Sendrecv allocate (stat_sr(mpi_status_size)) call MPI_SENDRECV (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, stat_sr, ierr) 10

31 MPI_ISEND/IRECV/WAITALL 1d-srb1.f: Isend/Irecv/Waitall allocate (stat_send(mpi_status_size,neibpetot)) allocate (stat_recv(mpi_status_size,neibpetot)) allocate (request_send(neibpetot)) allocate (request_recv(neibpetot)) call MPI_ISEND (SENDbuf(neib), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) call MPI_IRECV (RECVbuf(neib), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) call MPI_WAITALL (NEIBPETOT, request_send, stat_send, ierr) request status MPI_IsendMPI_IrecvMPI_Waitall requeststatus 11 MPI_SENDRECV 1d-srb.f: Sendrecv allocate (stat_sr(mpi_status_size)) call MPI_SENDRECV (SENDbuf(neib), BUFlength, len_s, NEIBPE(neib), 0, RECVbuf(neib), BUFlength, len_r, NEIBPE(neib), 0, MPI_COMM_WORLD, stat_sr, ierr) status status(mpi_status_size) Isend/Irecv/Waitall status 1 -- PREPARE send buffer do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= BUF(kk) -- SEND is = export_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) call MPI_ISEND (SENDbuf(is), len_s, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) RECV ir = import_index(neib-1) + 1 len_r= import_index(neib) - import_index(neib-1) call MPI_IRECV (RECVbuf(ir), len_r, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) -- WAITall for RECV call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) -- update array do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) BUF(kk)= RECVbuf(k) 14 SENDbuf neib#1 neib# neib#3 neib#4 RECVbuf neib#1 neib# neib#3 neib#4 export_index(0)+1 len_s len_s len_s len_s export_index(1)+1 export_index()+1 export_index(3)+1 export_index(4) len_r len_r len_r len_r import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4)

32 MPI Preconditioned Conjugate Gradient Method CG Compute r (0) = b-[a]x (0) for i= 1,, solve [M]z (i-1) = r (i-1) i-1 = r (i-1) z (i-1) if i=1 p (1) = z (0) else i-1 = i-1 / i- p (i) = z (i-1) + i-1 p (i) q (i) = [A]p (i) i = i-1 /p (i) q (i) x (i) = x (i-1) + i p (i) r (i) = r (i-1) - i q (i) check convergence r end SPMD 18 PE #0 PE #1 PE # PE #M-1 Program Program Program Program Data #0 Data #1 Data # Data #M-1

33 CG CPU 19 / 130 PE #0 PE #1 PE # PE #M-1 -- {q}= [A]{p} exchange W(i,P) X= X + ay Data #0 X= X + ay Data #1 X= X + ay Data # X= X + ay Data #M-1 do i= 1, N W(i,Q) = DIAG(i)*W(i,P) do j= INDEX(i-1)+1, INDEX(i) W(i,Q) = W(i,Q) + AMAT(j)*W(ITEM(j),P) / MPI_ALLREDUCE P#0 A0 B0 C0 D0 P#1 A1 B1 C1 D1 P# A B C D P#3 A3 B3 C3 D3 All reduce P#0 P#1 P# P#3 op.a0-a3 op.b0-b3 op.c0-c3 op.d0-d3 op.a0-a3 op.b0-b3 op.c0-c3 op.d0-d3 op.a0-a3 op.b0-b3 op.c0-c3 op.d0-d3 op.a0-a3 op.b0-b3 op.c0-c3 op.d0-d3 MPI_ALLREDUCE RHO= {r}{z} === RHO= 0.d0 === do i= 1, N RHO= RHO + W(i,R)*W(i,Z) allreduce RHO MPI_REDUCE + MPI_BCAST call MPI_ALLREDUCE (sendbuf,recvbuf,count,datatype,op, comm,ierr) sendbuf I recvbuf O datatype count I datatype I op I comm I ierr O

34 MPI_Reduce/Allreduce op call MPI_REDUCE (sendbuf,recvbuf,count,datatype,op,root,comm,ierr) MPI_MAXMPI_MIN MPI_SUMMPI_PROD MPI_LAND AND 133 $ cd <$1DH>/parallel $ mpif90 Oss noparallel heat_cg_p.f $ mpicc -Os -noparallel heat_cg_p.c $ qsub go.sh 134 real(kind=8):: X0, X1 call MPI_REDUCE (X0, X1, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, <comm>, ierr) real(kind=8):: X0(4), XMAX(4) call MPI_REDUCE (X0, XMAX, 4, MPI_DOUBLE_PRECISION, MPI_MAX, 0, <comm>, ierr) 1/7 program CG_poi implicit REAL*8 (A-H,O-Z) include 'mpif.h' 13 /7 136 integer :: PETOT, my_rank, ierr integer :: N, ITERmax integer :: R, Z, P, Q, DD real(kind=8) :: dx, RESID, dphi, dphimax, BF, EPS real(kind=8), dimension(:), allocatable :: PHI, RHS real(kind=8), dimension(: ), allocatable :: DIAG, AMAT real(kind=8), dimension(:,:), allocatable :: W integer, dimension(: ), allocatable :: INDEX, ITEM -- CTRL data if (my_rank.eq.0) then open (11, file='input.dat', status='unknown') read (11,*) Ng read (11,*) dx, BF read (11,*) ITERmax read (11,*) EPS close (11) integer(kind=4) :: NEIBPETOT, BUFlength integer(kind=4), dimension() :: NEIBPE integer(kind=4), dimension(0:) :: import_index, export_index integer(kind=4), dimension( ) :: import_item, export_item real(kind=8), dimension() :: SENDbuf, RECVbuf integer(kind=4), dimension(:), allocatable :: stat INIT === -- MPI init. call MPI_INIT (ierr) call MPI_COMM_SIZE (MPI_COMM_WORLD, PETOT, ierr ) call MPI_COMM_RANK (MPI_COMM_WORLD, my_rank, ierr ) call MPI_BCAST (Ng, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (ITERmax, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (dx, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (BF, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (EPS, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -- LOCAL MESH size N= Ng / PETOT if (N.le.1) goto 900 nr = Ng - nnn*petot if (my_rank+1.le.nr) N= N + 1

35 /7 3/7 -- CTRL data if (my_rank.eq.0) then open (11, file='input.dat', status='unknown') read (11,*) N read (11,*) dx, BF read (11,*) ITERmax read (11,*) EPS close (11) call MPI_BCAST (Ng, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (ITERmax, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (dx, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (BF, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (EPS, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -- LOCAL MESH size N= Ng / PETOT if (N.le.1) goto 900 nr = Ng - nnn*petot if (my_rank+1.le.nr) N= N MATRIX allocate (PHI(N+), DIAG(N), AMAT(*N),RHS(N)) allocate (INDEX(0:N), ITEM(*N), W(N+,4)) PHI= 0.d0 AMAT= 1.d0/dX DIAG= -.d0/dx RHS= -BF * dx INDEX= -- CONNECTIVITY INDEX(0)= 0 if (my_rank.eq.0) INDEX(1 )= 1 if (my_rank.eq.petot-1) INDEX(nnn)= 1 do i= 1, nnn INDEX(i)= INDEX(i) + INDEX(i-1) i1 i i 1 x BF x 0 x i 1 Ti i i1 i i1 BF x x x x x A L A D A R RHS A D (1) A R (1) A L () A D () A R () A L (3) A D (3) A R (3) A L (4) A D (4) A R (4) A L () A D () A R () A L (6) A D (6) A R (6) A L (7) A D (7) A R (7) A L (8) A D (8) /7 4/7 -- MATRIX allocate (PHI(0:N+1), DIAG(N), AMAT(*N),RHS(N)) allocate (INDEX(0:N), ITEM(*N), W(0:N+1,4)) PHI= 0.d0 AMAT= 1.d0/dX DIAG= -.d0/dx RHS= -BF * dx INDEX= -- CONNECTIVITY INDEX(0)= 0 if (my_rank.eq.0) INDEX(1)= 1 if (my_rank.eq.petot-1) INDEX(N)= 1 do i= 1, N INDEX(i)= INDEX(i) + INDEX(i-1) AD1 AR1 AL AD AR AL3 AD3 AR3 AL4 AD4 AR4 AL AD AR AL6 AD6 AR6 AL7 AD7 AR7 AL8 AD8 do i= 1, N js= INDEX(i-1) if (my_rank.eq.0.and. i.eq.1) then ITEM(jS+1)= i+1 Xmin AMAT(jS+1)= 0.d0 DIAG(i )= 1.d0 RHS(i )= 0.d0 else if (my_rank.eq.petot-1.and. i.eq.n) then ITEM(jS+1)= i-1 Xmax DIAG(i )= -1.d0/dX else ITEM(jS+1)= i-1 ITEM(jS+)= i+1 if (i.eq.1) ITEM(jS+1)= N+1 if (i.eq.n) ITEM(jS+)= N+ if (my_rank.eq.0.and.i.eq.n) ITEM(jS+)= N+1 if (my_rank.eq.0.and.i-1.eq.1) then AMAT(jS+1)= 0.d0 1 1 PE#

36 141 C NEIBPETOT= NEIBPE(1)= my_rank - 1 NEIBPE()= my_rank NEIBPETOT= NEIBPE[0]= my_rank - 1 NEIBPE[1]= my_rank + 1 SENDbuf(1)=BUF(1) SENDbuf()=BUF(4) BUF(0)=RECVbuf(1) BUF()=RECVbuf() import_index(1)= 1 import_index()= import_item (1)= N+1 import_item ()= N+ export_index(1)= 1 export_index()= export_item (1)= 1 export_item ()= N SENDbuf[0]=BUF[0] SENDbuf[1]=BUF[3] BUF[4]=RECVbuf[0] BUF[]=RECVbuf[1] import_index[1]= 0 import_index[]= 1 import_item [0]= N import_item [1]= N+1 export_index[1]= 0 export_index[]= 1 export_item [0]= 0 export_item [1]= N-1 if (my_rank.eq.0) then import_item (1)= N+1 export_item (1)= N NEIBPE(1)= my_rank+1 if (my_rank.eq.0) then import_item [0]= N export_item [0]= N-1 NEIBPE[0]= my_rank /7 4/7 do i= 1, N js= INDEX(i-1) if (my_rank.eq.0.and. i.eq.1) then ITEM(jS+1)= i+1 Xmin AMAT(jS+1)= 0.d0 DIAG(i )= 1.d0 RHS(i )= 0.d0 else if (my_rank.eq.petot-1.and. i.eq.n) then ITEM(jS+1)= i-1 DIAG(i )= -1.d0/dX else ITEM(jS+1)= i-1 ITEM(jS+)= i+1 if (i.eq.1) ITEM(jS+1)= N+1 if (i.eq.n) ITEM(jS+)= N+ if (my_rank.eq.0.and.i.eq.n) ITEM(jS+)= N+1 if (my_rank.eq.0.and.i-1.eq.1) then AMAT(jS+1)= 0.d0 do i= 1, N js= INDEX(i-1) if (my_rank.eq.0.and. i.eq.1) then ITEM(jS+1)= i+1 AMAT(jS+1)= 0.d0 DIAG(i )= 1.d0 RHS(i )= 0.d0 else if (my_rank.eq.petot-1.and. i.eq.n) then ITEM(jS+1)= i-1 Xmax DIAG(i )= -1.d0/dX else ITEM(jS+1)= i-1 ITEM(jS+)= i+1 if (i.eq.1) ITEM(jS+1)= N+1 if (i.eq.n) ITEM(jS+)= N+ if (my_rank.eq.0.and.i.eq.n) ITEM(jS+)= N+1 if (my_rank.eq.0.and.i-1.eq.1) then AMAT(jS+1)= 0.d0 1 3 N N+1 N N

37 /7 4/7 do i= 1, N js= INDEX(i-1) if (my_rank.eq.0.and. i.eq.1) then ITEM(jS+1)= i+1 AMAT(jS+1)= 0.d0 DIAG(i )= 1.d0 RHS(i )= 0.d0 else if (my_rank.eq.petot-1.and. i.eq.n) then ITEM(jS+1)= i-1 DIAG(i )= -1.d0/dX else ITEM(jS+1)= i-1 ITEM(jS+)= i+1 if (i.eq.1) ITEM(jS+1)= N+1 if (i.eq.n) ITEM(jS+)= N+ if (my_rank.eq.0.and.i.eq.n) ITEM(jS+)= N+1 if (my_rank.eq.0.and.i-1.eq.1) then AMAT(jS+1)= 0.d0 do i= 1, N js= INDEX(i-1) if (my_rank.eq.0.and. i.eq.1) then ITEM(jS+1)= i+1 AMAT(jS+1)= 0.d0 DIAG(i )= 1.d0 RHS(i )= 0.d0 else if (my_rank.eq.petot-1.and. i.eq.n) then ITEM(jS+1)= i-1 DIAG(i )= -1.d0/dX else ITEM(jS+1)= i-1 ITEM(jS+)= i+1 if (i.eq.1) ITEM(jS+1)= N+1 if (i.eq.n) ITEM(jS+)= N+ if (my_rank.eq.0.and.i.eq.n) ITEM(jS+)= N+1 if (my_rank.eq.0.and.i-1.eq.1) then AMAT(jS+1)= 0.d0 N N N+ N N N /7 do i= 1, N js= INDEX(i-1) if (my_rank.eq.0.and. i.eq.1) then ITEM(jS+1)= i+1 AMAT(jS+1)= 0.d0 DIAG(i )= 1.d0 RHS(i )= 0.d0 else if (my_rank.eq.petot-1.and. i.eq.n) then ITEM(jS+1)= i-1 DIAG(i )= -1.d0/dX else ITEM(jS+1)= i-1 ITEM(jS+)= i+1 if (i.eq.1) ITEM(jS+1)= N+1 if (i.eq.n) ITEM(jS+)= N+ if (my_rank.eq.0.and.i.eq.n) ITEM(jS+)= N+1 if (my_rank.eq.0.and.i-1.eq.1) then AMAT(jS+1)= 0.d0 1 3 N N+1 /7 -- COMMUNICATION NEIBPETOT= if (my_rank.eq.0 ) NEIBPETOT= 1 if (my_rank.eq.petot-1) NEIBPETOT= 1 if (PETOT.eq.1) NEIBPETOT= 0 NEIBPE(1)= my_rank - 1 NEIBPE()= my_rank + 1 if (my_rank.eq.0 ) NEIBPE(1)= my_rank + 1 if (my_rank.eq.petot-1) NEIBPE(1)= my_rank - 1 BUFlength= 1 import_index= 0 export_index= 0 import_item = 0 export_item = 0 import_index(1)= 1 import_index()= import_item (1)= N+1 import_item ()= N+ export_index(1)= 1 export_index()= export_item (1)= 1 export_item ()= N if (my_rank.eq.0) then import_item (1)= N+1 export_item (1)= N

38 1D PE PE SENDbuf(1)=BUF(1) BUF(0)=RECVbuf(1) SENDbuf()=BUF(4) BUF()=RECVbuf() SENDbuf(1)=BUF(1) BUF(0)=RECVbuf(1) SENDbuf()=BUF(4) BUF()=RECVbuf() NEIBPETOT= NEIBPE(1)= my_rank - 1 NEIBPE()= my_rank + 1 import_index(1)= 1 import_index()= import_item (1)= N+1 import_item ()= N+ export_index(1)= 1 export_index()= export_item (1)= 1 export_item ()= N 10 0~N+11~N PE# if (my_rank.eq.0) then import_item (1)= N+1 export_item (1)= N NEIBPE(1)= my_rank+1 C SENDbuf[0]=BUF[0] BUF[4]=RECVbuf[0] SENDbuf[1]=BUF[3] BUF[]=RECVbuf[1] NEIBPETOT= NEIBPE[0]= my_rank - 1 NEIBPE[1]= my_rank + 1 import_index[1]= 0 import_index[]= 1 import_item [0]= N import_item [1]= N+1 export_index[1]= 0 export_index[]= 1 export_item [0]= 0 export_item [1]= N-1 if (my_rank.eq.0) then import_item [0]= N export_item [0]= N-1 NEIBPE[0]= my_rank {q}= [A]{p} - 6/7 init do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= W(kk,P) -- SEND RECV. is= export_index(neib-1) + 1 ir= import_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) len_r= import_index(neib) - import_index(neib-1) call MPI_SENDRECV (SENDbuf(is), len_s, MPI_DOUBLE_PRECISION,NEIBPE(neib),0, - RECVbuf(ir), len_r, MPI_DOUBLE_PRECISION,NEIBPE(neib),0, MPI_COMM_WORLD, stat1, ierr) update do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) W(kk,P)= RECVbuf(k) do i= 1, N W(i,Q) = DIAG(i)*W(i,P) do j= INDEX(i-1)+1, INDEX(i) W(i,Q) = W(i,Q) + AMAT(j)*W(ITEM(j),P) W(i,p) 1

39 NEIBPETOTNEIBPE(neib) SENDbuf(1)=BUF(1) SENDbuf()=BUF(4) NEIBPETOT=, NEIB(1)= my_rank-1, NEIB()= my_rank+1 export_index(neib), neib= 0, NEIBPETOT export_index(0)=0, export_index(1)= 1, export_index()= export_item(k), k= 1, export_index(neibpetot) export_item(1)= 1, export_item()= N SENDbuf(k), k= 1, export_index(neibpetot) SENDbuf(1)= BUF(1), SENDbuf()= BUF(N) 13 SENDbuf MPI_Isend/Irecv/Waitall export_index(0)+1 neib#1 neib# neib#3 neib#4 BUFlength_e BUFlength_e BUFlength_e BUFlength_e export_index(1)+1 export_index()+1 do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= VAL(kk) is_e= export_index(neib-1) + 1 ie_e= export_index(neib ) BUFlength_e= ie_e is_e export_index(3)+1 call MPI_ISEND (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_send(neib), ierr) call MPI_WAITALL (NEIBPETOT, request_send, stat_recv, ierr) 14 export_index(4) SENDbuf MPI_Sendrecv neib#1 neib# neib#3 neib#4 BUFlength_e BUFlength_e BUFlength_e BUFlength_e export_index(0)+1 export_index(1)+1 export_index()+1 export_index(3)+1 export_index(4) do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= VAL(kk) is_e= export_index(neib-1) + 1 ie_e= export_index(neib ) BUFlength_e= ie_e is_e call MPI_SENDRECV (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, stat_sr, ierr) 1 NEIBPETOTNEIBPE(neib) : BUF()=RECVbuf(1) NEIBPETOT=, NEIB(1)= my_rank-1, NEIB()= my_rank+1 import_index(neib), neib= 0, NEIBPETOT import_index(0)=0, import_index(1)= 1, import_index()= import_item(k), k= 1, import_index(neibpetot) import_item(1)= N+1, import_item()= N+ RECVbuf(k), k= 1, import_index(neibpetot) BUF(N+1)=RECVbuf(1), BUF(N+)=RECVbuf() BUF(6)=RECVbuf() 16

40 MPI_Isend/Irecv/Waitall 17 MPI_Sendrecv 18 is_i= import_index(neib-1) + 1 ie_i= import_index(neib ) BUFlength_i= ie_i is_i is_i= import_index(neib-1) + 1 ie_i= import_index(neib ) BUFlength_i= ie_i is_i call MPI_IRECV (RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, request_recv(neib), ierr) call MPI_WAITALL (NEIBPETOT, request_recv, stat_recv, ierr) do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) VAL(kk)= RECVbuf(k) call MPI_SENDRECV (SENDbuf(iS_e), BUFlength_e, MPI_INTEGER, NEIBPE(neib), 0, RECVbuf(iS_i), BUFlength_i, MPI_INTEGER, NEIBPE(neib), 0, MPI_COMM_WORLD, stat_sr, ierr) do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) VAL(kk)= RECVbuf(k) RECVbuf neib#1 neib# neib#3 neib#4 RECVbuf neib#1 neib# neib#3 neib#4 BUFlength_i BUFlength_i BUFlength_i BUFlength_i import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4) BUFlength_i BUFlength_i BUFlength_i BUFlength_i import_index(0)+1 import_index(1)+1 import_index()+1 import_index(3)+1 import_index(4) 6/7 19 6/ {q}= [A]{p} - init do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= W(kk,P) -- SEND RECV. is= export_index(neib-1) + 1 ir= import_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) len_r= import_index(neib) - import_index(neib-1) call MPI_SENDRECV (SENDbuf(is), len_s, MPI_DOUBLE_PRECISION,NEIBPE(neib),0, - RECVbuf(ir), len_r, MPI_DOUBLE_PRECISION,NEIBPE(neib),0, MPI_COMM_WORLD, stat1, ierr) update do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) W(kk,P)= RECVbuf(k) do i= 1, N W(i,Q) = DIAG(i)*W(i,P) do j= INDEX(i-1)+1, INDEX(i) W(i,Q) = W(i,Q) + AMAT(j)*W(ITEM(j),P) -- {q}= [A]{p} - init do k= export_index(neib-1)+1, export_index(neib) kk= export_item(k) SENDbuf(k)= W(kk,P) -- SEND RECV. is= export_index(neib-1) + 1 ir= import_index(neib-1) + 1 len_s= export_index(neib) - export_index(neib-1) len_r= import_index(neib) - import_index(neib-1) call MPI_SENDRECV (SENDbuf(is), len_s, MPI_DOUBLE_PRECISION,NEIBPE(neib),0, - RECVbuf(ir), len_r, MPI_DOUBLE_PRECISION,NEIBPE(neib),0, MPI_COMM_WORLD, stat1, ierr) update do k= import_index(neib-1)+1, import_index(neib) kk= import_item(k) W(kk,P)= RECVbuf(k) do i= 1, N W(i,Q) = DIAG(i)*W(i,P) do j= INDEX(i-1)+1, INDEX(i) W(i,Q) = W(i,Q) + AMAT(j)*W(ITEM(j),P) PE W(i,p) {q}=[a]{p}

41 7/7 -- ALPHA= RHO / {p}{q} C10= 0.d0 do i= 1, N C10= C10 + W(i,P)*W(i,Q) call MPI_allREDUCE (C10, C1, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) ALPHA= RHO / C1 -- {x}= {x} + ALPHA*{p} {r}= {r} - ALPHA*{q} do i= 1, N PHI(i) = PHI(i) + ALPHA * W(i,P) W (i,r)= W(i,R) - ALPHA * W(i,Q) DNRM0 = 0.0 do i= 1, N DNRM0= DNRM0 + W(i,R)** call MPI_allREDUCE (DNRM0, DNRM, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) RESID= dsqrt(dnrm/bnrm) 161 go.shinput.dat PENg #@$-r paracg #@$-q lecture7 #@$-N 1 #@$-J T16 #@$-e err #@$-o test-016.lst #@$-lm 8GB #@$-lt 00:1:00 #@$ cd $PBS_O_WORKDIR mpirun n1.sh./a.out d0 1.d d-7 16 if (my_rank.eq.0.and.mod(iter,1000).eq.0) then write (*, '(i,1pe16.6)') iter, RESID exit if ( RESID.le.EPS) goto 900 RHO1 = RHO 163