Skip to content

Commit b16cfbe

Browse files
kah3fkah3f
authored
Merge pull request #110 from uvarc/staging
Added new example programs for MPI
2 parents 11bc500 + 324e964 commit b16cfbe

14 files changed

+413
-56
lines changed

‎content/courses/fortran-introduction/array_intrinsics.md

+2-1
Original file line numberDiff line numberDiff line change
@@ -38,9 +38,10 @@ SPREAD(SOURCE,DIM,NCOPIES)
3838
```
3939
**Example**
4040
```fortran
41-
!Array and mask are of size NxM
41+
!Array and mask are of shape NxM
4242
mask=A<0
4343
merge(A,0,mask)
44+
!B of shape MxN
4445
B=reshape(A,(/M,N/))
4546
! for C=1, D=[1,2]
4647
print *, spread(C, 1, 2) ! "1 1"

‎content/courses/fortran-introduction/codes/a.out

17.6 KB
Binary file not shown.

‎content/courses/fortran-introduction/codes/reshape.f90

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
PROGRAM test_sum
2+
INTEGER, DIMENSION(2) :: S
3+
INTEGER, DIMENSION(12) :: X
4+
INTEGER, DIMENSION(4,3):: A
5+
6+
x=[(i,i=1,12)]
7+
s=[3,4]
8+
A=RESHAPE(x,(/4,3/))
9+
print *, SIZE(A),SHAPE(x),SHAPE(A)
10+
11+
END PROGRAM
12+
13+

‎content/courses/parallel-computing-introduction/codes/a.out

30.6 KB
Binary file not shown.

‎content/courses/parallel-computing-introduction/codes/mpi_nonblock_halo.cxx

+1-1
Original file line numberDiff line numberDiff line change
@@ -92,8 +92,8 @@ int main (int argc, char *argv[]) {
9292
}
9393
}
9494

95-
MPI_Request requests[4];
9695
int nrequests=4;
96+
MPI_Request requests[nrequests];
9797

9898
MPI_Irecv(&w[nrl+1][1], ncl, MPI_DOUBLE, down, tag, MPI_COMM_WORLD, &requests[0]);
9999
MPI_Irecv(&w[0][1], ncl, MPI_DOUBLE, up, tag, MPI_COMM_WORLD, &requests[1]);

‎content/courses/parallel-computing-introduction/codes/mpi_vector_type.cxx

+133
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,133 @@
1+
#include <iostream>
2+
#include <iomanip>
3+
#include <mpi.h>
4+
5+
using namespace std;
6+
7+
int main (int argc, char *argv[]) {
8+
9+
int i, j;
10+
int N;
11+
12+
// Added for MPI
13+
int nr, nc;
14+
int rank, nprocs;
15+
int root=0, tag=0;
16+
int src, dest;
17+
18+
//Initialize MPI
19+
MPI_Init(&argc, &argv);
20+
MPI_Comm_size(MPI_COMM_WORLD,&nprocs);
21+
MPI_Comm_rank(MPI_COMM_WORLD,&rank);
22+
23+
N = nprocs;
24+
nr = N+2;
25+
nc = N;
26+
27+
double **w=new double*[nr];
28+
double *wptr=new double[(nr)*(nc)];
29+
30+
for (i=0;i<nr;++i,wptr+=nc) {
31+
w[i] = wptr;
32+
}
33+
34+
for ( i = 0; i < nr; i++ ) {
35+
for (j = 0; j < nc; j++ ) {
36+
w[i][j] = 0.;
37+
}
38+
}
39+
40+
double **u=new double*[nr];
41+
double *uptr=new double[(nr)*(nc)];
42+
43+
for (i=0;i<nr;++i,uptr+=nc) {
44+
u[i] = uptr;
45+
}
46+
47+
double counter=1.;
48+
for ( i = 0; i < nr; i++ ) {
49+
for (j = 0; j < nc; j++ ) {
50+
u[i][j] = counter;
51+
counter++;
52+
}
53+
}
54+
55+
//#Cyclic sending
56+
if (rank == nprocs-1) {
57+
src=rank-1;
58+
dest=0;
59+
}
60+
else if (rank==0) {
61+
src=nprocs-1;
62+
dest=1;
63+
}
64+
else {
65+
src=rank-1;
66+
dest=rank+1;
67+
}
68+
69+
//These values pick a total of nc (ncount) items, one item
70+
//(blocklength) taken for each nr (stride) items
71+
72+
//The length of the column is the number of rows
73+
int ncount=nr;
74+
//The number of items picked from each stride is 1
75+
int blocklength=1;
76+
//The length of the row is the number of columns
77+
int stride=nc;
78+
79+
MPI_Datatype cols;
80+
MPI_Type_vector(ncount,blocklength,stride,MPI_DOUBLE,&cols);
81+
MPI_Type_commit(&cols);
82+
83+
int nrequests=2;
84+
MPI_Request requests[nrequests];
85+
86+
if (rank==0) {
87+
MPI_Irecv(&w[0][0], 1, cols, src, tag, MPI_COMM_WORLD, &requests[0]);
88+
MPI_Isend(&u[0][0], 1, cols, dest, tag, MPI_COMM_WORLD, &requests[1]);
89+
}
90+
else if (rank==nprocs-1) {
91+
MPI_Irecv(&w[0][nprocs-1], 1, cols, src, tag, MPI_COMM_WORLD, &requests[0]);
92+
MPI_Isend(&u[0][nprocs-1], 1, cols, dest, tag, MPI_COMM_WORLD, &requests[1]);
93+
}
94+
else {
95+
MPI_Irecv(&w[0][rank], 1, cols, src, tag, MPI_COMM_WORLD, &requests[0]);
96+
MPI_Isend(&u[0][rank], 1, cols, dest, tag, MPI_COMM_WORLD, &requests[1]);
97+
}
98+
99+
MPI_Status status_arr[nrequests];
100+
MPI_Waitall(nrequests,requests,status_arr);
101+
102+
103+
MPI_Type_free(&cols);
104+
105+
//Try to print neatly
106+
107+
//U is the same for each rank in this example
108+
109+
if (rank==0) {
110+
cout<<"U"<<endl;
111+
for (i=0;i<nr;i++) {
112+
for (j=0;j<nc;j++) {
113+
cout<<setprecision(6)<<u[i][j]<<" ";
114+
}
115+
cout<<endl;
116+
}
117+
}
118+
119+
MPI_Barrier(MPI_COMM_WORLD);
120+
cout<<endl;
121+
MPI_Barrier(MPI_COMM_WORLD);
122+
cout<<"W for rank "<<rank<<endl;
123+
for (i=0;i<nr;i++) {
124+
for (j=0;j<nc;j++) {
125+
cout<<setprecision(6)<<w[i][j]<<" ";
126+
}
127+
cout<<endl;
128+
}
129+
cout<<endl;
130+
131+
MPI_Finalize();
132+
133+
}

‎content/courses/parallel-computing-introduction/codes/mpi_vector_type.f90

+47-32
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,8 @@ program sendrows
77

88
integer :: nr, nc
99
integer :: rank, nprocs, tag=0
10-
integer :: err, errcode
1110
integer :: ncount, blocklength, stride
11+
integer :: nrequests
1212
type(MPI_Status), dimension(:), allocatable :: mpi_status_arr
1313
type(MPI_Request), dimension(:), allocatable :: mpi_requests
1414
type(MPI_Datatype) :: rows
@@ -21,13 +21,17 @@ program sendrows
2121
call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs)
2222
call MPI_COMM_RANK(MPI_COMM_WORLD,rank)
2323

24-
!We will make the matrix scale with number of processes for simplicity
25-
nr=nprocs
26-
nc=nprocs
24+
N=nprocs
25+
nr=N
26+
nc=N+2
27+
28+
nrequests=2
2729

2830
allocate(u(nr,nc),w(nr,nc))
29-
allocate(mpi_requests(2*nprocs),mpi_status_arr(2*nprocs))
30-
u=0.0d0
31+
allocate(mpi_requests(nrequests),mpi_status_arr(nrequests))
32+
33+
u=reshape([(i,i=1,nr*nc)],(/nr,nc/))
34+
3135
w=0.0d0
3236

3337
!Cyclic sending
@@ -36,51 +40,62 @@ program sendrows
3640
dest=0
3741
else if (rank==0) then
3842
src=nprocs-1
39-
dest=rank+1
43+
dest=1
4044
else
4145
src=rank-1
4246
dest=rank+1
4347
endif
4448

45-
ncount=1
46-
blocklength=nc
49+
! These values pick a total of nc (ncount) items, one item
50+
! (blocklength) taken for each nr (stride) items
51+
52+
! The length of the row is the number of columns
53+
ncount=nc
54+
! The number of items picked from each stride is 1
55+
blocklength=1
56+
! The length of the column is the number of rows
4757
stride=nr
4858

4959
call MPI_Type_vector(ncount,blocklength,stride,MPI_DOUBLE_PRECISION,rows)
5060

5161
call MPI_TYPE_COMMIT(rows)
5262

53-
do i=0,nprocs-1
54-
if (rank==i) then
55-
tag=i
56-
print *, i,i+1,i+nprocs+1
57-
if (i==0) then
58-
call MPI_Irecv(w(nprocs,1),1,rows,src,tag,MPI_COMM_WORLD,mpi_requests(i+1))
59-
call MPI_Isend(u(i+1,1),1,rows,dest,tag,MPI_COMM_WORLD,mpi_requests(i+nprocs+1))
60-
else if (i==nprocs-1) then
61-
call MPI_Irecv(w(1,1),1,rows,src,tag,MPI_COMM_WORLD,mpi_requests(i+1))
62-
call MPI_Isend(u(nprocs,1),1,rows,dest,tag,MPI_COMM_WORLD,mpi_requests(i+nprocs+1))
63-
else
64-
call MPI_Irecv(w(i+2,1),1,rows,src,tag,MPI_COMM_WORLD,mpi_requests(i+1))
65-
call MPI_Isend(u(i+1,1),1,rows,dest,tag,MPI_COMM_WORLD,mpi_requests(i+nprocs+1))
66-
endif
67-
endif
68-
enddo
63+
if (rank==0) then
64+
call MPI_Irecv(w(1,1),1,rows,src,tag,MPI_COMM_WORLD,mpi_requests(1))
65+
call MPI_Isend(u(1,1),1,rows,dest,tag,MPI_COMM_WORLD,mpi_requests(2))
66+
else if (rank==nprocs-1) then
67+
call MPI_Irecv(w(nprocs,1),1,rows,src,tag,MPI_COMM_WORLD,mpi_requests(1))
68+
call MPI_Isend(u(nprocs,1),1,rows,dest,tag,MPI_COMM_WORLD,mpi_requests(2))
69+
else
70+
call MPI_Irecv(w(rank+1,1),1,rows,src,tag,MPI_COMM_WORLD,mpi_requests(1))
71+
call MPI_Isend(u(rank+1,1),1,rows,dest,tag,MPI_COMM_WORLD,mpi_requests(2))
72+
endif
6973

7074
call MPI_Waitall(size(mpi_requests),mpi_requests,mpi_status_arr)
7175

72-
7376
call MPI_TYPE_FREE(rows)
7477

7578
!Print neatly
76-
do i=1,nr
77-
write(*,*) "|",u(i,:),"|"," |",w(i,:),"|"
79+
80+
! U is the same for each rank in this example
81+
if (rank==0) then
82+
write(*,*) "U"
83+
do j=1,nr
84+
write(*,'(*(g12.6))') u(j,:)
85+
enddo
86+
endif
87+
call MPI_Barrier(MPI_COMM_WORLD)
88+
do i=1,nprocs
89+
call MPI_Barrier(MPI_COMM_WORLD)
90+
if (rank==i-1) then
91+
write(*,*)
92+
write(*,*) "W for rank ",rank
93+
do j=1,nr
94+
write(*,'(*(g12.6))') w(j,:)
95+
enddo
96+
endif
7897
enddo
7998

8099
call MPI_Finalize()
81100

82101
end program
83-
84-
85-
86-

‎content/courses/parallel-computing-introduction/codes/mpi_vector_type.py

+83
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
import sys
2+
import numpy as np
3+
from mpi4py import MPI
4+
5+
comm = MPI.COMM_WORLD
6+
rank = comm.Get_rank()
7+
nprocs = comm.Get_size()
8+
9+
N = nprocs
10+
nr = N+2
11+
nc = N
12+
13+
u = np.arange(1,nr*nc+1).reshape(nr,nc)
14+
15+
w = np.zeros_like(u)
16+
17+
#Cyclic sending
18+
if rank == nprocs-1:
19+
src=rank-1
20+
dest=0
21+
elif (rank==0):
22+
src=nprocs-1
23+
dest=1
24+
else:
25+
src=rank-1
26+
dest=rank+1
27+
28+
#These values pick a total of nc (ncount) items, one item
29+
#(blocklength) taken for each nr (stride) items
30+
31+
#The length of the column is the number of rows
32+
ncount=nr
33+
#The number of items picked from each stride is 1
34+
blocklength=1
35+
#The length of the row is the number of columns
36+
stride=nc
37+
38+
cols = MPI.DOUBLE.Create_vector(ncount, blocklength, stride)
39+
cols.Commit()
40+
41+
if rank==0:
42+
recv_request=comm.Irecv([np.frombuffer(w.data,np.double,offset=0),1,cols],src)
43+
send_request=comm.Isend([np.frombuffer(u.data,np.double,offset=0),1,cols],dest)
44+
elif rank==nprocs-1:
45+
sendcol=nprocs-1
46+
recv_request=comm.Irecv([np.frombuffer(w.data,np.double,offset=sendcol*np.dtype('double').itemsize),1,cols],src)
47+
send_request=comm.Isend([np.frombuffer(u.data,np.double,offset=sendcol*np.dtype('double').itemsize),1,cols],dest)
48+
else:
49+
sendcol=rank
50+
recv_request=comm.Irecv([np.frombuffer(w.data,np.double,offset=sendcol*np.dtype('double').itemsize),1,cols],src)
51+
send_request=comm.Isend([np.frombuffer(u.data,np.double,offset=sendcol*np.dtype('double').itemsize),1,cols],dest)
52+
53+
requests=[recv_request,send_request]
54+
55+
MPI.Request.Waitall(requests)
56+
57+
cols.Free()
58+
59+
#Print neatly
60+
61+
#U is the same for each rank in this example
62+
63+
if rank==0:
64+
print("U")
65+
for i in range(nr):
66+
for j in range(nc):
67+
print("{:12.6f}".format(u[i,j]),end="")
68+
print()
69+
70+
print()
71+
72+
comm.Barrier()
73+
74+
print("W for rank", rank)
75+
comm.Barrier()
76+
for i in range(nr):
77+
for j in range(nc):
78+
print("{:12.6f}".format(w[i,j]),end="")
79+
print()
80+
81+
print()
82+
83+

‎content/courses/parallel-computing-introduction/distributed_mpi_build_run.md

+1-1
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ Each MPI program must include the `mpi.h` header file. If the MPI distribution w
2727

2828
All new Fortran programs should use the `mpi` module provided by the MPI software. if the MPI distribution was installed correctly, the `mpif90` or equivalent will find the module and link to the correct library.
2929

30-
Any recent MPI will also provide an `mpi_f08` module. Its use is recommended, but we will wait till [later](courses/paralll-incomputing-introduction/distributed_mpi_nonblocking_exchange) to introduce it. This new module takes better advance of modern Fortran features such as types. The compiler used must support at least the Fortran 2008 standard.
30+
Any recent MPI will also provide an `mpi_f08` module. Its use is recommended, but we will wait till [later](courses/paralll-incomputing-introduction/distributed_mpi_nonblocking_exchange) to introduce it. This new module takes better advance of modern Fortran features such as types. In addition, the ubuiquitous "ierror" parameter at the end of most argument lists becomes an _optional_ argument in the mpi_f08 subroutine definitions. The compiler used must support at least the Fortran 2008 standard.
3131

3232
{{< spoiler text="Fortran" >}}
3333
{{< code-download file="/courses/parallel-computing-introduction/codes/mpi1.f90" lang="fortran" >}}

0 commit comments

Comments
 (0)