From 748ef4b27d0a3fb1df802d42cc514c185df068a0 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Fri, 15 Sep 2023 17:24:32 +0100 Subject: [PATCH 01/16] Add Fortran 90 implementions of routines --- tutorials/mpi-fortran/code/check_status.f90 | 50 +++++++++++++++++ tutorials/mpi-fortran/code/makefile | 30 ++++++++++ .../mpi-fortran/code/mpi_hello_world.f90 | 30 ++++++++++ tutorials/mpi-fortran/code/my_bcast.f90 | 49 +++++++++++++++++ tutorials/mpi-fortran/code/ping_pong.f90 | 40 ++++++++++++++ tutorials/mpi-fortran/code/probe.f90 | 55 +++++++++++++++++++ tutorials/mpi-fortran/code/ring.f90 | 40 ++++++++++++++ tutorials/mpi-fortran/code/send_recv.f90 | 27 +++++++++ 8 files changed, 321 insertions(+) create mode 100644 tutorials/mpi-fortran/code/check_status.f90 create mode 100644 tutorials/mpi-fortran/code/makefile create mode 100644 tutorials/mpi-fortran/code/mpi_hello_world.f90 create mode 100644 tutorials/mpi-fortran/code/my_bcast.f90 create mode 100644 tutorials/mpi-fortran/code/ping_pong.f90 create mode 100644 tutorials/mpi-fortran/code/probe.f90 create mode 100644 tutorials/mpi-fortran/code/ring.f90 create mode 100644 tutorials/mpi-fortran/code/send_recv.f90 diff --git a/tutorials/mpi-fortran/code/check_status.f90 b/tutorials/mpi-fortran/code/check_status.f90 new file mode 100644 index 0000000..824f81e --- /dev/null +++ b/tutorials/mpi-fortran/code/check_status.f90 @@ -0,0 +1,50 @@ +program check_status + implicit none + + include 'mpif.h' + + integer world_rank, world_size, ierror + integer MAX_NUMBERS + parameter (MAX_NUMBERS=100) + integer numbers(MAX_NUMBERS) + integer number_amount + integer recv_status(MPI_STATUS_SIZE) + + real r + + call MPI_INIT(ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + + if (world_rank .eq. 0) then + ! Pick a random amount of integers to send to process one + call srand(time()) + + ! Throw away first value + r = rand() + + number_amount = int(rand() * real(MAX_NUMBERS)) + ! Send the amount of integers to process one + call MPI_SEND(numbers, number_amount, MPI_INT, 1, 9, & + MPI_COMM_WORLD, ierror) + print '("0 sent ", I0, " numbers to 1")', number_amount + else if (world_rank .eq. 1) then + ! Receive at most MAX_NUMBERS from process zero + call MPI_RECV(numbers, MAX_NUMBERS, MPI_INT, 0, 9, & + MPI_COMM_WORLD, recv_status, ierror) + ! After receiving the message, check the status to determine how many + ! numbers were actually received + call MPI_Get_count(recv_status, MPI_INT, number_amount, ierror) + ! Print off the amount of numbers, and also print additional information + ! in the status object + print '("1 received ", I0, " numbers from 0. Message source = ", I0, ", tag = ", I0)', & + number_amount , recv_status(MPI_SOURCE) , recv_status(MPI_TAG) + end if + + call MPI_Barrier(MPI_COMM_WORLD, ierror) + + call MPI_FINALIZE(ierror) + +end program + diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile new file mode 100644 index 0000000..5262694 --- /dev/null +++ b/tutorials/mpi-fortran/code/makefile @@ -0,0 +1,30 @@ +EXECS=mpi_hello_world send_recv ping_pong ring check_status probe my_bcast +MPIF90?=mpif90 + +all: $(EXECS) + +mpi_hello_world: mpi_hello_world.f90 + $(MPIF90) mpi_hello_world.f90 -o mpi_hello_world + +send_recv: send_recv.f90 + $(MPIF90) send_recv.f90 -o send_recv + +ping_pong: ping_pong.f90 + $(MPIF90) ping_pong.f90 -o ping_pong + +ring: ring.f90 + $(MPIF90) ring.f90 -o ring + +check_status: check_status.f90 + $(MPIF90) check_status.f90 -o check_status + +probe: probe.f90 + $(MPIF90) probe.f90 -o probe + +my_bcast: my_bcast.f90 + $(MPIF90) my_bcast.f90 -o my_bcast + + +clean: + rm -f $(EXECS) + diff --git a/tutorials/mpi-fortran/code/mpi_hello_world.f90 b/tutorials/mpi-fortran/code/mpi_hello_world.f90 new file mode 100644 index 0000000..cbc2759 --- /dev/null +++ b/tutorials/mpi-fortran/code/mpi_hello_world.f90 @@ -0,0 +1,30 @@ +program hello_world_mpi + implicit none + + include 'mpif.h' + + integer process_rank, size_of_cluster, ierror + character (len=MPI_MAX_PROCESSOR_NAME) :: process_name + integer resultlen + + ! Initialize the MPI environment + call MPI_INIT(ierror) + + ! Get the number of processes + call MPI_COMM_SIZE(MPI_COMM_WORLD, size_of_cluster, ierror) + + ! Get the rank of the process + call MPI_COMM_RANK(MPI_COMM_WORLD, process_rank, ierror) + + ! Get the name of the processor + call MPI_GET_PROCESSOR_NAME(process_name, resultlen, ierror) + + ! Print off an hello world message + write (*,*) 'Hello World from processor ', trim(process_name), ' rank ', & + process_rank, 'of ', size_of_cluster, 'processors' + + ! Finalize the MPI environment + call MPI_FINALIZE(ierror) + +end program + diff --git a/tutorials/mpi-fortran/code/my_bcast.f90 b/tutorials/mpi-fortran/code/my_bcast.f90 new file mode 100644 index 0000000..1704041 --- /dev/null +++ b/tutorials/mpi-fortran/code/my_bcast.f90 @@ -0,0 +1,49 @@ +subroutine my_bcast(data, count, datatype, root, communicator) + integer, intent (inout) :: data + integer, intent (in) :: count, root, communicator, datatype + + integer world_rank, world_size, ierror + integer i + + call MPI_COMM_SIZE(communicator, world_size, ierror) + call MPI_COMM_RANK(communicator, world_rank, ierror) + + if (world_rank .eq. root) then + ! If we are the root process, send our data to everyone + do i = 0, world_size - 1 + if (i .ne. world_rank) then + call MPI_SEND(data, count, datatype, i, 0, communicator, ierror) + end if + end do + else + ! If we are a receiver process, receive the data from the root + call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) + end if +end subroutine + +program main + implicit none + + include 'mpif.h' + + integer world_rank, ierror + integer data + + call MPI_INIT(ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + if (world_rank .eq. 0) then + data = 100 + print '("Process 0 broadcasting data ", I0)', data + call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD) + else + call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD) + print '("Process ", I0, " received data ", I0, " from root process")', & + world_rank, data + end if + + ! Finalize the MPI environment + call MPI_FINALIZE(ierror) + +end program + diff --git a/tutorials/mpi-fortran/code/ping_pong.f90 b/tutorials/mpi-fortran/code/ping_pong.f90 new file mode 100644 index 0000000..14a8166 --- /dev/null +++ b/tutorials/mpi-fortran/code/ping_pong.f90 @@ -0,0 +1,40 @@ +program ping_pong + implicit none + + include 'mpif.h' + + integer world_rank, world_size, ierror + integer partner_rank + integer ping_pong_count, ping_pong_limit + integer recv_status(MPI_STATUS_SIZE) + + + call MPI_INIT(ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + ping_pong_count = 0 + ping_pong_limit = 10 + + partner_rank = mod(world_rank + 1, 2) + + do while (ping_pong_count .lt. ping_pong_limit) + if (world_rank .eq. mod(ping_pong_count, 2)) then + ! Increment the ping pong count before you send it + ping_pong_count = ping_pong_count + 1 + call MPI_SEND(ping_pong_count, 1, MPI_INT, partner_rank, 0, & + MPI_COMM_WORLD, ierror) + print '(I0, " sent and incremented ping_pong_count ", I0, " to ", I0)', & + world_rank, ping_pong_count, partner_rank + else + call MPI_RECV(ping_pong_count, 1, MPI_INT, partner_rank, 0, & + MPI_COMM_WORLD, recv_status, ierror) + print '(I0, " received ping_pong_count ", I0, " from ", I0)', & + world_rank, ping_pong_count, partner_rank + end if + end do + + call MPI_FINALIZE(ierror) + +end program + diff --git a/tutorials/mpi-fortran/code/probe.f90 b/tutorials/mpi-fortran/code/probe.f90 new file mode 100644 index 0000000..2535353 --- /dev/null +++ b/tutorials/mpi-fortran/code/probe.f90 @@ -0,0 +1,55 @@ +program probe + implicit none + + include 'mpif.h' + + integer world_rank, world_size, ierror + integer MAX_NUMBERS + parameter (MAX_NUMBERS=100) + integer, allocatable :: numbers(:) + integer number_amount + integer recv_status(MPI_STATUS_SIZE) + + real r + + call MPI_INIT(ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + + if (world_rank .eq. 0) then + ! Pick a random amount of integers to send to process one + call srand(time()) + + ! Throw away first value + r = rand() + + number_amount = int(rand() * real(MAX_NUMBERS)) + allocate(numbers(MAX_NUMBERS)) + ! Send the random amount of integers to process one + call MPI_SEND(numbers, number_amount, MPI_INT, 1, 0, & + MPI_COMM_WORLD, ierror) + print '("0 sent ", I0, " numbers to 1")', number_amount + else if (world_rank .eq. 1) then + ! Probe for an incoming message from process zero + call MPI_PROBE(0, 0, MPI_COMM_WORLD, recv_status, ierror) + + ! When probe returns, the status object has the size and other + ! attributes of the incoming message. Get the message size + call MPI_Get_count(recv_status, MPI_INT, number_amount, ierror) + + ! Allocate a buffer to hold the incoming numbers + allocate(numbers(number_amount)) + + ! Now receive the message with the allocated buffer + call MPI_RECV(numbers, number_amount, MPI_INT, 0, 0, & + MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror) + print '("1 dynamically received ", I0, " numbers from 0.")', & + number_amount + deallocate(numbers) + end if + + call MPI_FINALIZE(ierror) + +end program + diff --git a/tutorials/mpi-fortran/code/ring.f90 b/tutorials/mpi-fortran/code/ring.f90 new file mode 100644 index 0000000..e600538 --- /dev/null +++ b/tutorials/mpi-fortran/code/ring.f90 @@ -0,0 +1,40 @@ +program ring + implicit none + + include 'mpif.h' + + integer world_rank, world_size, ierror + integer token + integer recv_status(MPI_STATUS_SIZE) + + + call MPI_INIT(ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + + if (world_rank .ne. 0) then + call MPI_RECV(token, 1, MPI_INT, world_rank - 1, 0, & + MPI_COMM_WORLD, recv_status, ierror) + print '("Process ", I0, " received token ", I0, " from process ", I0)', & + world_rank, token, world_rank - 1 + else + ! Set the token's value if you are process 0 + token = -1 + end if + + call MPI_SEND(token, 1, MPI_INT, mod(world_rank + 1, world_size), 0, & + MPI_COMM_WORLD, ierror) + + ! Now process 0 can receive from the last process. + if (world_rank .eq. 0) then + call MPI_RECV(token, 1, MPI_INT, world_size - 1, 0, & + MPI_COMM_WORLD, recv_status, ierror) + print '("Process ", I0, " received token ", I0, " from process ", I0)', & + world_rank, token, world_size - 1 + end if + + call MPI_FINALIZE(ierror) + +end program + diff --git a/tutorials/mpi-fortran/code/send_recv.f90 b/tutorials/mpi-fortran/code/send_recv.f90 new file mode 100644 index 0000000..04ae9da --- /dev/null +++ b/tutorials/mpi-fortran/code/send_recv.f90 @@ -0,0 +1,27 @@ +program send_recv + implicit none + + include 'mpif.h' + + integer world_rank, world_size, ierror + integer num + integer recv_status(MPI_STATUS_SIZE) + + + call MPI_INIT(ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + if (world_rank .eq. 0) then + num = -1 + call MPI_SEND(num, 1, MPI_INT, 1, 0, & + MPI_COMM_WORLD, ierror) + else if (world_rank .eq. 1) then + call MPI_RECV(num, 1, MPI_INT, 0, 0, & + MPI_COMM_WORLD, recv_status, ierror) + print '("Process 1 received number ", I0, " from process 0")', num + end if + + call MPI_FINALIZE(ierror) + +end program From 9c7546a2eb9498887a857644dc1cd51c9f221bf2 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Sat, 16 Sep 2023 11:04:02 +0100 Subject: [PATCH 02/16] Add Fortran implementations for broadcast code --- tutorials/mpi-fortran/code/compare_bcast.f90 | 91 ++++++++++++++++++++ tutorials/mpi-fortran/code/makefile | 5 +- tutorials/mpi-fortran/code/my_bcast.f90 | 14 +-- 3 files changed, 102 insertions(+), 8 deletions(-) create mode 100644 tutorials/mpi-fortran/code/compare_bcast.f90 diff --git a/tutorials/mpi-fortran/code/compare_bcast.f90 b/tutorials/mpi-fortran/code/compare_bcast.f90 new file mode 100644 index 0000000..7c7c10b --- /dev/null +++ b/tutorials/mpi-fortran/code/compare_bcast.f90 @@ -0,0 +1,91 @@ +subroutine my_bcast(data, count, datatype, root, communicator, ierror) + integer, intent (in) :: count, root, communicator, datatype + integer, intent (inout) :: data(count) + integer, intent (inout) :: ierror + + integer world_rank, world_size + integer i + + call MPI_COMM_SIZE(communicator, world_size, ierror) + call MPI_COMM_RANK(communicator, world_rank, ierror) + + if (world_rank .eq. root) then + ! If we are the root process, send our data to everyone + do i = 0, world_size - 1 + if (i .ne. world_rank) then + call MPI_SEND(data, count, datatype, i, 0, communicator, ierror) + end if + end do + else + ! If we are a receiver process, receive the data from the root + call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) + end if +end subroutine + +program main + + use iso_fortran_env, only : error_unit + + implicit none + + include 'mpif.h' + + integer :: num_args, num_elements, num_trials + character(12) :: args(2) + integer world_rank, ierror + real total_my_bcast_time, total_mpi_bcast_time + integer i + integer, allocatable :: data(:) + + num_args = command_argument_count() + + if (num_args .ne. 2) then + write (error_unit, *) 'Usage: compare_bcast num_elements num_trials' + stop + end if + + call get_command_argument(1, args(1)) + call get_command_argument(2, args(2)) + + read (args(1), *) num_elements + read (args(2), *) num_trials + + call MPI_INIT(ierror) + + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + total_my_bcast_time = 0.0 + total_mpi_bcast_time = 0.0 + + allocate(data(num_elements)) + + do i = 1, num_trials + ! Time my_bcast + ! Synchronize before starting timing + call MPI_Barrier(MPI_COMM_WORLD, ierror) + total_my_bcast_time = total_my_bcast_time - MPI_Wtime() + call my_bcast(data, num_elements, MPI_INT, 0, MPI_COMM_WORLD, ierror) + ! Synchronize again before obtaining final time + call MPI_Barrier(MPI_COMM_WORLD, ierror) + total_my_bcast_time = total_my_bcast_time + MPI_Wtime() + + ! Time MPI_Bcast + call MPI_Barrier(MPI_COMM_WORLD, ierror) + total_mpi_bcast_time = total_mpi_bcast_time - MPI_Wtime() + call MPI_Bcast(data, num_elements, MPI_INT, 0, MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD, ierror) + total_mpi_bcast_time = total_mpi_bcast_time + MPI_Wtime() + end do + + ! Print off timing information + if (world_rank .eq. 0) then + print '("Data size = ", I0, ", Trials = ", I0)', num_elements, num_trials + print '("Avg my_bcast time = ", ES12.5)', total_my_bcast_time / num_trials + print '("Avg mpi_bcast time = ", ES12.5)', total_mpi_bcast_time / num_trials + end if + + ! Finalize the MPI environment + + call MPI_FINALIZE(ierror) + +end program diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 5262694..c0e23db 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,4 +1,4 @@ -EXECS=mpi_hello_world send_recv ping_pong ring check_status probe my_bcast +EXECS=mpi_hello_world send_recv ping_pong ring check_status probe my_bcast compare_bcast MPIF90?=mpif90 all: $(EXECS) @@ -24,6 +24,9 @@ probe: probe.f90 my_bcast: my_bcast.f90 $(MPIF90) my_bcast.f90 -o my_bcast +compare_bcast: compare_bcast.f90 + $(MPIF90) compare_bcast.f90 -o compare_bcast + clean: rm -f $(EXECS) diff --git a/tutorials/mpi-fortran/code/my_bcast.f90 b/tutorials/mpi-fortran/code/my_bcast.f90 index 1704041..b32bcbe 100644 --- a/tutorials/mpi-fortran/code/my_bcast.f90 +++ b/tutorials/mpi-fortran/code/my_bcast.f90 @@ -1,8 +1,9 @@ -subroutine my_bcast(data, count, datatype, root, communicator) - integer, intent (inout) :: data +subroutine my_bcast(data, count, datatype, root, communicator, ierror) integer, intent (in) :: count, root, communicator, datatype + integer, intent (inout) :: data(count) + integer, intent (inout) :: ierror - integer world_rank, world_size, ierror + integer world_rank, world_size integer i call MPI_COMM_SIZE(communicator, world_size, ierror) @@ -27,7 +28,7 @@ program main include 'mpif.h' integer world_rank, ierror - integer data + integer data(1) call MPI_INIT(ierror) call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) @@ -35,9 +36,9 @@ program main if (world_rank .eq. 0) then data = 100 print '("Process 0 broadcasting data ", I0)', data - call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD) + call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD, ierror) else - call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD) + call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD, ierror) print '("Process ", I0, " received data ", I0, " from root process")', & world_rank, data end if @@ -46,4 +47,3 @@ program main call MPI_FINALIZE(ierror) end program - From c77ed49761b037d4fe248273aaca2c11d0fa9d3f Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Tue, 19 Sep 2023 16:09:24 +0100 Subject: [PATCH 03/16] Tidy up variable declarations --- tutorials/mpi-fortran/code/check_status.f90 | 18 +++++++------- tutorials/mpi-fortran/code/compare_bcast.f90 | 24 +++++++++---------- .../mpi-fortran/code/mpi_hello_world.f90 | 8 +++---- tutorials/mpi-fortran/code/my_bcast.f90 | 18 +++++++------- tutorials/mpi-fortran/code/ping_pong.f90 | 13 +++++----- tutorials/mpi-fortran/code/probe.f90 | 16 ++++++------- tutorials/mpi-fortran/code/ring.f90 | 11 ++++----- tutorials/mpi-fortran/code/send_recv.f90 | 10 ++++---- 8 files changed, 55 insertions(+), 63 deletions(-) diff --git a/tutorials/mpi-fortran/code/check_status.f90 b/tutorials/mpi-fortran/code/check_status.f90 index 824f81e..0378642 100644 --- a/tutorials/mpi-fortran/code/check_status.f90 +++ b/tutorials/mpi-fortran/code/check_status.f90 @@ -1,16 +1,15 @@ program check_status - implicit none + use mpi - include 'mpif.h' + implicit none - integer world_rank, world_size, ierror - integer MAX_NUMBERS - parameter (MAX_NUMBERS=100) - integer numbers(MAX_NUMBERS) - integer number_amount - integer recv_status(MPI_STATUS_SIZE) + integer :: world_rank, world_size, ierror + integer, parameter :: MAX_NUMBERS=100 + integer :: numbers(MAX_NUMBERS) + integer :: number_amount + integer :: recv_status(MPI_STATUS_SIZE) - real r + real :: r call MPI_INIT(ierror) call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) @@ -47,4 +46,3 @@ program check_status call MPI_FINALIZE(ierror) end program - diff --git a/tutorials/mpi-fortran/code/compare_bcast.f90 b/tutorials/mpi-fortran/code/compare_bcast.f90 index 7c7c10b..6ff9e9a 100644 --- a/tutorials/mpi-fortran/code/compare_bcast.f90 +++ b/tutorials/mpi-fortran/code/compare_bcast.f90 @@ -1,10 +1,10 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) - integer, intent (in) :: count, root, communicator, datatype + integer, intent (in) :: count, root, communicator, datatype integer, intent (inout) :: data(count) - integer, intent (inout) :: ierror + integer, intent (out) :: ierror - integer world_rank, world_size - integer i + integer :: world_rank, world_size + integer :: i call MPI_COMM_SIZE(communicator, world_size, ierror) call MPI_COMM_RANK(communicator, world_rank, ierror) @@ -20,21 +20,19 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) ! If we are a receiver process, receive the data from the root call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) end if -end subroutine +end subroutine my_bcast program main - + use mpi use iso_fortran_env, only : error_unit implicit none - include 'mpif.h' - - integer :: num_args, num_elements, num_trials - character(12) :: args(2) - integer world_rank, ierror - real total_my_bcast_time, total_mpi_bcast_time - integer i + integer :: num_args, num_elements, num_trials + character(12) :: args(2) + integer :: world_rank, ierror + real :: total_my_bcast_time, total_mpi_bcast_time + integer :: i integer, allocatable :: data(:) num_args = command_argument_count() diff --git a/tutorials/mpi-fortran/code/mpi_hello_world.f90 b/tutorials/mpi-fortran/code/mpi_hello_world.f90 index cbc2759..979a797 100644 --- a/tutorials/mpi-fortran/code/mpi_hello_world.f90 +++ b/tutorials/mpi-fortran/code/mpi_hello_world.f90 @@ -1,11 +1,12 @@ program hello_world_mpi + use mpi + implicit none - include 'mpif.h' + integer :: process_rank, size_of_cluster, ierror + integer :: resultlen - integer process_rank, size_of_cluster, ierror character (len=MPI_MAX_PROCESSOR_NAME) :: process_name - integer resultlen ! Initialize the MPI environment call MPI_INIT(ierror) @@ -27,4 +28,3 @@ program hello_world_mpi call MPI_FINALIZE(ierror) end program - diff --git a/tutorials/mpi-fortran/code/my_bcast.f90 b/tutorials/mpi-fortran/code/my_bcast.f90 index b32bcbe..79d1c7b 100644 --- a/tutorials/mpi-fortran/code/my_bcast.f90 +++ b/tutorials/mpi-fortran/code/my_bcast.f90 @@ -1,10 +1,10 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) - integer, intent (in) :: count, root, communicator, datatype + integer, intent (in) :: count, root, communicator, datatype integer, intent (inout) :: data(count) - integer, intent (inout) :: ierror + integer, intent (out) :: ierror - integer world_rank, world_size - integer i + integer :: world_rank, world_size + integer :: i call MPI_COMM_SIZE(communicator, world_size, ierror) call MPI_COMM_RANK(communicator, world_rank, ierror) @@ -20,15 +20,15 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) ! If we are a receiver process, receive the data from the root call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) end if -end subroutine +end subroutine my_bcast program main - implicit none + use mpi - include 'mpif.h' + implicit none - integer world_rank, ierror - integer data(1) + integer :: world_rank, ierror + integer :: data(1) call MPI_INIT(ierror) call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) diff --git a/tutorials/mpi-fortran/code/ping_pong.f90 b/tutorials/mpi-fortran/code/ping_pong.f90 index 14a8166..88c9cbb 100644 --- a/tutorials/mpi-fortran/code/ping_pong.f90 +++ b/tutorials/mpi-fortran/code/ping_pong.f90 @@ -1,12 +1,12 @@ program ping_pong - implicit none + use mpi - include 'mpif.h' + implicit none - integer world_rank, world_size, ierror - integer partner_rank - integer ping_pong_count, ping_pong_limit - integer recv_status(MPI_STATUS_SIZE) + integer :: world_rank, world_size, ierror + integer :: partner_rank + integer :: ping_pong_count, ping_pong_limit + integer :: recv_status(MPI_STATUS_SIZE) call MPI_INIT(ierror) @@ -37,4 +37,3 @@ program ping_pong call MPI_FINALIZE(ierror) end program - diff --git a/tutorials/mpi-fortran/code/probe.f90 b/tutorials/mpi-fortran/code/probe.f90 index 2535353..2d19047 100644 --- a/tutorials/mpi-fortran/code/probe.f90 +++ b/tutorials/mpi-fortran/code/probe.f90 @@ -1,16 +1,15 @@ program probe - implicit none + use mpi - include 'mpif.h' + implicit none - integer world_rank, world_size, ierror - integer MAX_NUMBERS - parameter (MAX_NUMBERS=100) + integer :: world_rank, world_size, ierror + integer, parameter :: MAX_NUMBERS=100 integer, allocatable :: numbers(:) - integer number_amount - integer recv_status(MPI_STATUS_SIZE) + integer :: number_amount + integer :: recv_status(MPI_STATUS_SIZE) - real r + real :: r call MPI_INIT(ierror) call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) @@ -52,4 +51,3 @@ program probe call MPI_FINALIZE(ierror) end program - diff --git a/tutorials/mpi-fortran/code/ring.f90 b/tutorials/mpi-fortran/code/ring.f90 index e600538..f14ac8a 100644 --- a/tutorials/mpi-fortran/code/ring.f90 +++ b/tutorials/mpi-fortran/code/ring.f90 @@ -1,11 +1,11 @@ program ring - implicit none + use mpi - include 'mpif.h' + implicit none - integer world_rank, world_size, ierror - integer token - integer recv_status(MPI_STATUS_SIZE) + integer :: world_rank, world_size, ierror + integer :: token + integer :: recv_status(MPI_STATUS_SIZE) call MPI_INIT(ierror) @@ -37,4 +37,3 @@ program ring call MPI_FINALIZE(ierror) end program - diff --git a/tutorials/mpi-fortran/code/send_recv.f90 b/tutorials/mpi-fortran/code/send_recv.f90 index 04ae9da..e9eb8d2 100644 --- a/tutorials/mpi-fortran/code/send_recv.f90 +++ b/tutorials/mpi-fortran/code/send_recv.f90 @@ -1,11 +1,11 @@ program send_recv - implicit none + use mpi - include 'mpif.h' + implicit none - integer world_rank, world_size, ierror - integer num - integer recv_status(MPI_STATUS_SIZE) + integer :: world_rank, world_size, ierror + integer :: num + integer :: recv_status(MPI_STATUS_SIZE) call MPI_INIT(ierror) From 4639eaf5a67300af8c7c4b1620005b57d963befb Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Sat, 23 Sep 2023 17:52:29 +0100 Subject: [PATCH 04/16] Add Fortran example of scatter, gather & allgather --- tutorials/mpi-fortran/code/all_avg.f90 | 98 +++++++++++++++++++++++ tutorials/mpi-fortran/code/avg.f90 | 105 +++++++++++++++++++++++++ tutorials/mpi-fortran/code/makefile | 11 ++- 3 files changed, 212 insertions(+), 2 deletions(-) create mode 100644 tutorials/mpi-fortran/code/all_avg.f90 create mode 100644 tutorials/mpi-fortran/code/avg.f90 diff --git a/tutorials/mpi-fortran/code/all_avg.f90 b/tutorials/mpi-fortran/code/all_avg.f90 new file mode 100644 index 0000000..0c80d48 --- /dev/null +++ b/tutorials/mpi-fortran/code/all_avg.f90 @@ -0,0 +1,98 @@ +module subs + implicit none +contains + subroutine create_rand_nums(rand_nums, num_elements) + ! Creates an array of random numbers. Each number has a value from 0 - 1 + integer, intent(in) :: num_elements + real, intent(out) :: rand_nums(num_elements) + + integer :: i + + do i = 1, num_elements + rand_nums(i) = rand() + end do + + end subroutine create_rand_nums + + function compute_avg(array, num_elements) + ! Computes the average of an array of numbers + real :: compute_avg + integer, intent(in) :: num_elements + real, intent(in) :: array(num_elements) + + compute_avg = sum(array) / real(num_elements) + end function compute_avg +end module subs + +program main + use mpi + use iso_fortran_env, only: error_unit + use subs + + implicit none + + integer :: num_args + character(12) :: arg + integer :: num_elements_per_proc + integer :: world_size, world_rank, ierror + real :: r, sub_avg, avg, original_data_avg + real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) + + num_args = command_argument_count() + + if (num_args .ne. 1) then + write (error_unit, *) 'Usage: avg num_elements_per_proc' + stop + end if + + call get_command_argument(1, arg) + + read (arg, *) num_elements_per_proc + ! Seed the random number generator to get different results each time + call srand(time()) + ! Throw away first rand value + r = rand() + + call MPI_INIT(ierror) + + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + ! Create a random array of elements on the root process. Its total + ! size will be the number of elements per process times the number + ! of processes + if (world_rank .eq. 0) then + allocate(rand_nums(num_elements_per_proc * world_size)) + call create_rand_nums(rand_nums, num_elements_per_proc * world_size) + end if + + allocate(sub_rand_nums(num_elements_per_proc)) + + call MPI_Scatter(rand_nums, num_elements_per_proc, MPI_FLOAT, sub_rand_nums, & + num_elements_per_proc, MPI_FLOAT, 0, MPI_COMM_WORLD, ierror) + + ! Compute the average of your subset + sub_avg = compute_avg(sub_rand_nums, num_elements_per_proc) + + ! Gather all partial averages down to all the processes + allocate(sub_avgs(world_size)) + call MPI_Allgather(sub_avg, 1, MPI_FLOAT, sub_avgs, 1, MPI_FLOAT, MPI_COMM_WORLD, ierror) + + ! Now that we have all of the partial averages, compute the + ! total average of all numbers. Since we are assuming each process computed + ! an average across an equal amount of elements, this computation will + ! produce the correct answer. + avg = compute_avg(sub_avgs, world_size) + print '("Avg of all elements from proc ", I0, " is ", ES12.5)', world_rank, avg + + ! Clean up + if (world_rank .eq. 0) then + deallocate(rand_nums) + end if + deallocate(sub_avgs) + deallocate(sub_rand_nums) + + call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_FINALIZE(ierror) + +end program main diff --git a/tutorials/mpi-fortran/code/avg.f90 b/tutorials/mpi-fortran/code/avg.f90 new file mode 100644 index 0000000..4058893 --- /dev/null +++ b/tutorials/mpi-fortran/code/avg.f90 @@ -0,0 +1,105 @@ +module subs + implicit none +contains + subroutine create_rand_nums(rand_nums, num_elements) + ! Creates an array of random numbers. Each number has a value from 0 - 1 + integer, intent(in) :: num_elements + real, intent(out) :: rand_nums(num_elements) + + integer :: i + + do i = 1, num_elements + rand_nums(i) = rand() + end do + + end subroutine create_rand_nums + + function compute_avg(array, num_elements) + ! Computes the average of an array of numbers + real :: compute_avg + integer, intent(in) :: num_elements + real, intent(in) :: array(num_elements) + + compute_avg = sum(array) / real(num_elements) + end function compute_avg +end module subs + +program main + use mpi + use iso_fortran_env, only: error_unit + use subs + + implicit none + + integer :: num_args + character(12) :: arg + integer :: num_elements_per_proc + integer :: world_size, world_rank, ierror + real :: r, sub_avg, avg, original_data_avg + real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) + + num_args = command_argument_count() + + if (num_args .ne. 1) then + write (error_unit, *) 'Usage: avg num_elements_per_proc' + stop + end if + + call get_command_argument(1, arg) + + read (arg, *) num_elements_per_proc + ! Seed the random number generator to get different results each time + call srand(time()) + ! Throw away first rand value + r = rand() + + call MPI_INIT(ierror) + + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + ! Create a random array of elements on the root process. Its total + ! size will be the number of elements per process times the number + ! of processes + if (world_rank .eq. 0) then + allocate(rand_nums(num_elements_per_proc * world_size)) + call create_rand_nums(rand_nums, num_elements_per_proc * world_size) + end if + + allocate(sub_rand_nums(num_elements_per_proc)) + + call MPI_Scatter(rand_nums, num_elements_per_proc, MPI_FLOAT, sub_rand_nums, & + num_elements_per_proc, MPI_FLOAT, 0, MPI_COMM_WORLD, ierror) + + ! Compute the average of your subset + sub_avg = compute_avg(sub_rand_nums, num_elements_per_proc) + + ! Gather all partial averages down to the root process + if (world_rank .eq. 0) then + allocate(sub_avgs(world_size)) + end if + call MPI_Gather(sub_avg, 1, MPI_FLOAT, sub_avgs, 1, MPI_FLOAT, 0, MPI_COMM_WORLD, ierror) + + ! Now that we have all of the partial averages on the root, compute the + ! total average of all numbers. Since we are assuming each process computed + ! an average across an equal amount of elements, this computation will + ! produce the correct answer. + if (world_rank .eq. 0) then + avg = compute_avg(sub_avgs, world_size) + print '("Avg of all elements is ", ES12.5)', avg + ! Compute the average across the original data for comparison + original_data_avg = compute_avg(rand_nums, num_elements_per_proc * world_size) + print '("Avg computed across original data is ", ES12.5)', avg + end if + + ! Clean up + if (world_rank .eq. 0) then + deallocate(rand_nums) + deallocate(sub_avgs) + end if + deallocate(sub_rand_nums) + + call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_FINALIZE(ierror) + +end program main diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index c0e23db..323233a 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,4 +1,5 @@ -EXECS=mpi_hello_world send_recv ping_pong ring check_status probe my_bcast compare_bcast +EXECS=mpi_hello_world send_recv ping_pong ring check_status probe my_bcast compare_bcast avg all_avg +MOD_FILES=subs.mod MPIF90?=mpif90 all: $(EXECS) @@ -27,7 +28,13 @@ my_bcast: my_bcast.f90 compare_bcast: compare_bcast.f90 $(MPIF90) compare_bcast.f90 -o compare_bcast +avg: avg.f90 subs.mod + $(MPIF90) avg.f90 -o avg + +all_avg: all_avg.f90 subs.mod + $(MPIF90) all_avg.f90 -o all_avg + clean: - rm -f $(EXECS) + rm -f $(EXECS) $(MOD_FILES) From 9efdbf162bab5f5c811aa42ea2d7abeff686493c Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 28 Sep 2023 09:41:13 +0100 Subject: [PATCH 05/16] Fortran examples for reduce and allreduce --- tutorials/mpi-fortran/code/makefile | 8 +- tutorials/mpi-fortran/code/reduce_avg.f90 | 78 ++++++++++++++++++++ tutorials/mpi-fortran/code/reduce_std.f90 | 89 +++++++++++++++++++++++ 3 files changed, 174 insertions(+), 1 deletion(-) create mode 100644 tutorials/mpi-fortran/code/reduce_avg.f90 create mode 100644 tutorials/mpi-fortran/code/reduce_std.f90 diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 323233a..03efb21 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,4 +1,5 @@ -EXECS=mpi_hello_world send_recv ping_pong ring check_status probe my_bcast compare_bcast avg all_avg +EXECS=mpi_hello_world send_recv ping_pong ring check_status probe \ + my_bcast compare_bcast avg all_avg reduce_avg reduce_std MOD_FILES=subs.mod MPIF90?=mpif90 @@ -34,6 +35,11 @@ avg: avg.f90 subs.mod all_avg: all_avg.f90 subs.mod $(MPIF90) all_avg.f90 -o all_avg +reduce_avg: reduce_avg.f90 subs.mod + $(MPIF90) reduce_avg.f90 -o reduce_avg + +reduce_std: reduce_std.f90 subs.mod + $(MPIF90) reduce_std.f90 -o reduce_std clean: rm -f $(EXECS) $(MOD_FILES) diff --git a/tutorials/mpi-fortran/code/reduce_avg.f90 b/tutorials/mpi-fortran/code/reduce_avg.f90 new file mode 100644 index 0000000..391031b --- /dev/null +++ b/tutorials/mpi-fortran/code/reduce_avg.f90 @@ -0,0 +1,78 @@ +module subs + implicit none +contains + subroutine create_rand_nums(rand_nums, num_elements) + ! Creates an array of random numbers. Each number has a value from 0 - 1 + integer, intent(in) :: num_elements + real, intent(out) :: rand_nums(num_elements) + + integer :: i + + do i = 1, num_elements + rand_nums(i) = rand() + end do + + end subroutine create_rand_nums +end module subs + +program main + use mpi + use iso_fortran_env, only: error_unit + use subs + + implicit none + + integer :: num_args + character(12) :: arg + integer :: num_elements_per_proc + integer :: world_size, world_rank, ierror + real :: r, local_sum, global_sum + real, allocatable :: rand_nums(:) + + num_args = command_argument_count() + + if (num_args .ne. 1) then + write (error_unit, *) 'Usage: reduce_avg num_elements_per_proc' + stop + end if + + call get_command_argument(1, arg) + read (arg, *) num_elements_per_proc + + call MPI_INIT(ierror) + + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + + ! Create a random array of elements on all processes. + call srand(time()) ! Seed the random number generator to get different results each time for each processor + ! Throw away first rand value + r = rand() + allocate(rand_nums(num_elements_per_proc)) + call create_rand_nums(rand_nums, num_elements_per_proc) + + ! Sum the numbers locally + local_sum = sum(rand_nums) + + ! Print the random numbers on each process + print '("Local sum for process ", I0, " - ", ES12.5, ", avg = ", ES12.5)', & + world_rank, local_sum, local_sum / real(num_elements_per_proc) + + + ! Reduce all of the local sums into the global sum + call MPI_Reduce(local_sum, global_sum, 1, MPI_FLOAT, MPI_SUM, 0, & + MPI_COMM_WORLD, ierror) + + ! Print the result + if (world_rank .eq. 0) then + print '("Total sum = ", ES12.5, ", avg = ", ES12.5)', global_sum, & + global_sum / (world_size * num_elements_per_proc) + end if + + ! Clean up + deallocate(rand_nums) + + call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_FINALIZE(ierror) + +end program main diff --git a/tutorials/mpi-fortran/code/reduce_std.f90 b/tutorials/mpi-fortran/code/reduce_std.f90 new file mode 100644 index 0000000..b9e1201 --- /dev/null +++ b/tutorials/mpi-fortran/code/reduce_std.f90 @@ -0,0 +1,89 @@ +module subs + implicit none +contains + subroutine create_rand_nums(rand_nums, num_elements) + ! Creates an array of random numbers. Each number has a value from 0 - 1 + integer, intent(in) :: num_elements + real, intent(out) :: rand_nums(num_elements) + + integer :: i + + do i = 1, num_elements + rand_nums(i) = rand() + end do + + end subroutine create_rand_nums +end module subs + +program main + use mpi + use iso_fortran_env, only: error_unit + use subs + + implicit none + + integer :: num_args + character(12) :: arg + integer :: num_elements_per_proc + integer :: world_size, world_rank, ierror + real :: r, local_sum, global_sum, mean, local_sq_diff, global_sq_diff, stddev + real, allocatable :: rand_nums(:) + integer :: i + + num_args = command_argument_count() + + if (num_args .ne. 1) then + write (error_unit, *) 'Usage: reduce_std num_elements_per_proc' + stop + end if + + call get_command_argument(1, arg) + read (arg, *) num_elements_per_proc + + call MPI_INIT(ierror) + + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + + ! Create a random array of elements on all processes. + call srand(time()) ! Seed the random number generator of processes uniquely + ! Throw away first rand value + r = rand() + allocate(rand_nums(num_elements_per_proc)) + call create_rand_nums(rand_nums, num_elements_per_proc) + + ! Sum the numbers locally + local_sum = sum(rand_nums) + + ! Reduce all of the local sums into the global sum in order to + ! calculate the mean + call MPI_Allreduce(local_sum, global_sum, 1, MPI_FLOAT, MPI_SUM, & + MPI_COMM_WORLD, ierror) + mean = global_sum / real(num_elements_per_proc * world_size) + + ! Compute the local sum of the squared differences from the mean + local_sq_diff = 0.0 + do i = 1, num_elements_per_proc + local_sq_diff = local_sq_diff + (rand_nums(i) - mean) * (rand_nums(i) - mean) + end do + + ! Reduce the global sum of the squared differences to the root process + ! and print off the answer + call MPI_Reduce(local_sq_diff, global_sq_diff, 1, MPI_FLOAT, MPI_SUM, 0, & + MPI_COMM_WORLD, ierror) + + ! The standard deviation is the square root of the mean of the squared + ! differences + if (world_rank .eq. 0) then + stddev = sqrt(global_sq_diff / (num_elements_per_proc * world_size)) + print '("Mean - ", ES12.5, ", Standard deviation = ", ES12.5)', & + mean, stddev + end if + + ! Clean up + deallocate(rand_nums) + + call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_FINALIZE(ierror) + +end program main From 7c2128282fd5f6e695504f8f98e6854b18088c72 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 28 Sep 2023 09:46:29 +0100 Subject: [PATCH 06/16] Minor formatting --- tutorials/mpi-fortran/code/all_avg.f90 | 2 +- tutorials/mpi-fortran/code/compare_bcast.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tutorials/mpi-fortran/code/all_avg.f90 b/tutorials/mpi-fortran/code/all_avg.f90 index 0c80d48..ada0463 100644 --- a/tutorials/mpi-fortran/code/all_avg.f90 +++ b/tutorials/mpi-fortran/code/all_avg.f90 @@ -41,7 +41,7 @@ program main num_args = command_argument_count() if (num_args .ne. 1) then - write (error_unit, *) 'Usage: avg num_elements_per_proc' + write (error_unit, *) 'Usage: all_avg num_elements_per_proc' stop end if diff --git a/tutorials/mpi-fortran/code/compare_bcast.f90 b/tutorials/mpi-fortran/code/compare_bcast.f90 index 6ff9e9a..7033d01 100644 --- a/tutorials/mpi-fortran/code/compare_bcast.f90 +++ b/tutorials/mpi-fortran/code/compare_bcast.f90 @@ -24,7 +24,7 @@ end subroutine my_bcast program main use mpi - use iso_fortran_env, only : error_unit + use iso_fortran_env, only: error_unit implicit none From f811885ada4f8d33edd7201050763840fcbfaa73 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 28 Sep 2023 10:50:04 +0100 Subject: [PATCH 07/16] Fortran example of splitting communicator --- tutorials/mpi-fortran/code/makefile | 7 ++++-- tutorials/mpi-fortran/code/split.f90 | 32 ++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 2 deletions(-) create mode 100644 tutorials/mpi-fortran/code/split.f90 diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 03efb21..1c79464 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,5 +1,6 @@ EXECS=mpi_hello_world send_recv ping_pong ring check_status probe \ - my_bcast compare_bcast avg all_avg reduce_avg reduce_std + my_bcast compare_bcast avg all_avg reduce_avg reduce_std \ + split MOD_FILES=subs.mod MPIF90?=mpif90 @@ -41,6 +42,8 @@ reduce_avg: reduce_avg.f90 subs.mod reduce_std: reduce_std.f90 subs.mod $(MPIF90) reduce_std.f90 -o reduce_std +split: split.f90 + $(MPIF90) split.f90 -o split + clean: rm -f $(EXECS) $(MOD_FILES) - diff --git a/tutorials/mpi-fortran/code/split.f90 b/tutorials/mpi-fortran/code/split.f90 new file mode 100644 index 0000000..4a1d209 --- /dev/null +++ b/tutorials/mpi-fortran/code/split.f90 @@ -0,0 +1,32 @@ +program main + use mpi + + implicit none + + integer :: world_rank, world_size, ierror + integer :: color + integer :: row_comm + integer :: row_rank, row_size + + call MPI_INIT(ierror) + + ! Get the rank and size in the original communicator + call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierror) + call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierror) + + color = world_rank / 4 ! Determine color based on row + + ! Split the communicator based on the color and use the original rank for ordering + call MPI_Comm_split(MPI_COMM_WORLD, color, world_rank, row_comm, ierror) + + call MPI_Comm_rank(row_comm, row_rank, ierror) + call MPI_Comm_size(row_comm, row_size, ierror) + + print '("WORLD RANK/SIZE: ", I0, "/", I0, " --- ROW RANK/SIZE: ", I0, "/", I0)', & + world_rank, world_size, row_rank, row_size + + call MPI_Comm_free(row_comm, ierror) + + call MPI_Finalize(ierror) + +end program main From 7ccf5be3d30fdf989b93eaa20f50a55f7414fc3c Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 28 Sep 2023 10:51:35 +0100 Subject: [PATCH 08/16] Clean up declarations based on compiler warnings Add warnings flag to makefile and remove missing dependency. --- tutorials/mpi-fortran/code/all_avg.f90 | 2 +- tutorials/mpi-fortran/code/compare_bcast.f90 | 2 +- tutorials/mpi-fortran/code/makefile | 35 ++++++++++---------- 3 files changed, 20 insertions(+), 19 deletions(-) diff --git a/tutorials/mpi-fortran/code/all_avg.f90 b/tutorials/mpi-fortran/code/all_avg.f90 index ada0463..a3063a7 100644 --- a/tutorials/mpi-fortran/code/all_avg.f90 +++ b/tutorials/mpi-fortran/code/all_avg.f90 @@ -35,7 +35,7 @@ program main character(12) :: arg integer :: num_elements_per_proc integer :: world_size, world_rank, ierror - real :: r, sub_avg, avg, original_data_avg + real :: r, sub_avg, avg real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) num_args = command_argument_count() diff --git a/tutorials/mpi-fortran/code/compare_bcast.f90 b/tutorials/mpi-fortran/code/compare_bcast.f90 index 7033d01..24a8be2 100644 --- a/tutorials/mpi-fortran/code/compare_bcast.f90 +++ b/tutorials/mpi-fortran/code/compare_bcast.f90 @@ -31,7 +31,7 @@ program main integer :: num_args, num_elements, num_trials character(12) :: args(2) integer :: world_rank, ierror - real :: total_my_bcast_time, total_mpi_bcast_time + double precision :: total_my_bcast_time, total_mpi_bcast_time integer :: i integer, allocatable :: data(:) diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 1c79464..4ba808e 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -3,47 +3,48 @@ EXECS=mpi_hello_world send_recv ping_pong ring check_status probe \ split MOD_FILES=subs.mod MPIF90?=mpif90 +FFLAGS=-Wall all: $(EXECS) mpi_hello_world: mpi_hello_world.f90 - $(MPIF90) mpi_hello_world.f90 -o mpi_hello_world + $(MPIF90) $(FFLAGS) mpi_hello_world.f90 -o mpi_hello_world send_recv: send_recv.f90 - $(MPIF90) send_recv.f90 -o send_recv + $(MPIF90) $(FFLAGS) send_recv.f90 -o send_recv ping_pong: ping_pong.f90 - $(MPIF90) ping_pong.f90 -o ping_pong + $(MPIF90) $(FFLAGS) ping_pong.f90 -o ping_pong ring: ring.f90 - $(MPIF90) ring.f90 -o ring + $(MPIF90) $(FFLAGS) ring.f90 -o ring check_status: check_status.f90 - $(MPIF90) check_status.f90 -o check_status + $(MPIF90) $(FFLAGS) check_status.f90 -o check_status probe: probe.f90 - $(MPIF90) probe.f90 -o probe + $(MPIF90) $(FFLAGS) probe.f90 -o probe my_bcast: my_bcast.f90 - $(MPIF90) my_bcast.f90 -o my_bcast + $(MPIF90) $(FFLAGS) my_bcast.f90 -o my_bcast compare_bcast: compare_bcast.f90 - $(MPIF90) compare_bcast.f90 -o compare_bcast + $(MPIF90) $(FFLAGS) compare_bcast.f90 -o compare_bcast -avg: avg.f90 subs.mod - $(MPIF90) avg.f90 -o avg +avg: avg.f90 + $(MPIF90) $(FFLAGS) avg.f90 -o avg -all_avg: all_avg.f90 subs.mod - $(MPIF90) all_avg.f90 -o all_avg +all_avg: all_avg.f90 + $(MPIF90) $(FFLAGS) all_avg.f90 -o all_avg -reduce_avg: reduce_avg.f90 subs.mod - $(MPIF90) reduce_avg.f90 -o reduce_avg +reduce_avg: reduce_avg.f90 + $(MPIF90) $(FFLAGS) reduce_avg.f90 -o reduce_avg -reduce_std: reduce_std.f90 subs.mod - $(MPIF90) reduce_std.f90 -o reduce_std +reduce_std: reduce_std.f90 + $(MPIF90) $(FFLAGS) reduce_std.f90 -o reduce_std split: split.f90 - $(MPIF90) split.f90 -o split + $(MPIF90) $(FFLAGS) split.f90 -o split clean: rm -f $(EXECS) $(MOD_FILES) From b5471a677e0eb68a90250b247af63ba53201294b Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 28 Sep 2023 11:49:08 +0100 Subject: [PATCH 09/16] Fortran example of communicator groups --- tutorials/mpi-fortran/code/groups.f90 | 51 +++++++++++++++++++++++++++ tutorials/mpi-fortran/code/makefile | 5 ++- 2 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 tutorials/mpi-fortran/code/groups.f90 diff --git a/tutorials/mpi-fortran/code/groups.f90 b/tutorials/mpi-fortran/code/groups.f90 new file mode 100644 index 0000000..0f3468a --- /dev/null +++ b/tutorials/mpi-fortran/code/groups.f90 @@ -0,0 +1,51 @@ +program main + use mpi + + implicit none + + integer :: world_rank, world_size, ierror + integer :: world_group, prime_group + integer :: prime_comm + integer, parameter :: n = 7 + integer :: ranks(n) + integer :: prime_rank, prime_size + + call MPI_Init(ierror) + + ! Get the rank and size in the original communicator + call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierror) + call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierror) + + ! Get the group of processes in MPI_COMM_WORLD + call MPI_Comm_group(MPI_COMM_WORLD, world_group, ierror) + + ranks = [1, 2, 3, 5, 7, 11, 13] + + ! Construct a group containing all of the prime ranks in world_group + call MPI_Group_incl(world_group, 7, ranks, prime_group, ierror) + + ! Create a new communicator based on the group + call MPI_Comm_create_group(MPI_COMM_WORLD, prime_group, 0, prime_comm, ierror) + + prime_rank = -1 + prime_size = -1 + ! If this rank isn't in the new communicator, it will be MPI_COMM_NULL + ! Using MPI_COMM_NULL for MPI_Comm_rank or MPI_Comm_size is erroneous + if (MPI_COMM_NULL .ne. prime_comm) then + call MPI_Comm_rank(prime_comm, prime_rank, ierror) + call MPI_Comm_size(prime_comm, prime_size, ierror) + end if + + print '("WORLD RANK/SIZE: ", I0, "/", I0, " --- PRIME RANK/SIZE: ", I0, "/", I0)', & + world_rank, world_size, prime_rank, prime_size + + call MPI_Group_free(world_group, ierror) + call MPI_Group_free(prime_group, ierror) + + if (MPI_COMM_NULL .ne. prime_comm) then + call MPI_Comm_free(prime_comm, ierror) + end if + + call MPI_Finalize(ierror) + +end program main diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 4ba808e..3306296 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,6 +1,6 @@ EXECS=mpi_hello_world send_recv ping_pong ring check_status probe \ my_bcast compare_bcast avg all_avg reduce_avg reduce_std \ - split + split groups MOD_FILES=subs.mod MPIF90?=mpif90 FFLAGS=-Wall @@ -46,5 +46,8 @@ reduce_std: reduce_std.f90 split: split.f90 $(MPIF90) $(FFLAGS) split.f90 -o split +groups: groups.f90 + $(MPIF90) $(FFLAGS) groups.f90 -o groups + clean: rm -f $(EXECS) $(MOD_FILES) From e1c03bfebb87fe0e134ba1365f4330a63b23ca58 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Mon, 2 Oct 2023 16:29:50 +0100 Subject: [PATCH 10/16] Rename fortran split and group communicators code --- .../mpi-fortran/code/{groups.f90 => comm_groups.f90} | 0 .../mpi-fortran/code/{split.f90 => comm_split.f90} | 0 tutorials/mpi-fortran/code/makefile | 10 +++++----- 3 files changed, 5 insertions(+), 5 deletions(-) rename tutorials/mpi-fortran/code/{groups.f90 => comm_groups.f90} (100%) rename tutorials/mpi-fortran/code/{split.f90 => comm_split.f90} (100%) diff --git a/tutorials/mpi-fortran/code/groups.f90 b/tutorials/mpi-fortran/code/comm_groups.f90 similarity index 100% rename from tutorials/mpi-fortran/code/groups.f90 rename to tutorials/mpi-fortran/code/comm_groups.f90 diff --git a/tutorials/mpi-fortran/code/split.f90 b/tutorials/mpi-fortran/code/comm_split.f90 similarity index 100% rename from tutorials/mpi-fortran/code/split.f90 rename to tutorials/mpi-fortran/code/comm_split.f90 diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 3306296..53a7d7a 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,6 +1,6 @@ EXECS=mpi_hello_world send_recv ping_pong ring check_status probe \ my_bcast compare_bcast avg all_avg reduce_avg reduce_std \ - split groups + comm_split comm_groups MOD_FILES=subs.mod MPIF90?=mpif90 FFLAGS=-Wall @@ -43,11 +43,11 @@ reduce_avg: reduce_avg.f90 reduce_std: reduce_std.f90 $(MPIF90) $(FFLAGS) reduce_std.f90 -o reduce_std -split: split.f90 - $(MPIF90) $(FFLAGS) split.f90 -o split +comm_split: comm_split.f90 + $(MPIF90) $(FFLAGS) comm_split.f90 -o comm_split -groups: groups.f90 - $(MPIF90) $(FFLAGS) groups.f90 -o groups +comm_groups: comm_groups.f90 + $(MPIF90) $(FFLAGS) comm_groups.f90 -o comm_groups clean: rm -f $(EXECS) $(MOD_FILES) From b57e61e178b231546e2e49aa08588e1e6f40a58f Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 5 Oct 2023 17:44:47 +0100 Subject: [PATCH 11/16] Update to Fortran 2008 MPI library --- tutorials/mpi-fortran/code/all_avg.f90 | 18 +++++------ tutorials/mpi-fortran/code/avg.f90 | 18 +++++------ tutorials/mpi-fortran/code/check_status.f90 | 24 +++++++------- tutorials/mpi-fortran/code/comm_groups.f90 | 32 +++++++++---------- tutorials/mpi-fortran/code/comm_split.f90 | 22 ++++++------- tutorials/mpi-fortran/code/compare_bcast.f90 | 25 +++++++++------ .../mpi-fortran/code/mpi_hello_world.f90 | 2 +- tutorials/mpi-fortran/code/my_bcast.f90 | 17 +++++++--- tutorials/mpi-fortran/code/ping_pong.f90 | 18 +++++------ tutorials/mpi-fortran/code/probe.f90 | 22 ++++++------- tutorials/mpi-fortran/code/reduce_avg.f90 | 16 +++++----- tutorials/mpi-fortran/code/reduce_std.f90 | 18 +++++------ tutorials/mpi-fortran/code/ring.f90 | 20 ++++++------ tutorials/mpi-fortran/code/send_recv.f90 | 18 +++++------ 14 files changed, 142 insertions(+), 128 deletions(-) diff --git a/tutorials/mpi-fortran/code/all_avg.f90 b/tutorials/mpi-fortran/code/all_avg.f90 index a3063a7..b58cf8f 100644 --- a/tutorials/mpi-fortran/code/all_avg.f90 +++ b/tutorials/mpi-fortran/code/all_avg.f90 @@ -25,7 +25,7 @@ end function compute_avg end module subs program main - use mpi + use mpi_f08 use iso_fortran_env, only: error_unit use subs @@ -34,7 +34,7 @@ program main integer :: num_args character(12) :: arg integer :: num_elements_per_proc - integer :: world_size, world_rank, ierror + integer :: world_size, world_rank real :: r, sub_avg, avg real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) @@ -53,10 +53,10 @@ program main ! Throw away first rand value r = rand() - call MPI_INIT(ierror) + call MPI_INIT() - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) ! Create a random array of elements on the root process. Its total ! size will be the number of elements per process times the number @@ -69,14 +69,14 @@ program main allocate(sub_rand_nums(num_elements_per_proc)) call MPI_Scatter(rand_nums, num_elements_per_proc, MPI_FLOAT, sub_rand_nums, & - num_elements_per_proc, MPI_FLOAT, 0, MPI_COMM_WORLD, ierror) + num_elements_per_proc, MPI_FLOAT, 0, MPI_COMM_WORLD) ! Compute the average of your subset sub_avg = compute_avg(sub_rand_nums, num_elements_per_proc) ! Gather all partial averages down to all the processes allocate(sub_avgs(world_size)) - call MPI_Allgather(sub_avg, 1, MPI_FLOAT, sub_avgs, 1, MPI_FLOAT, MPI_COMM_WORLD, ierror) + call MPI_Allgather(sub_avg, 1, MPI_FLOAT, sub_avgs, 1, MPI_FLOAT, MPI_COMM_WORLD) ! Now that we have all of the partial averages, compute the ! total average of all numbers. Since we are assuming each process computed @@ -92,7 +92,7 @@ program main deallocate(sub_avgs) deallocate(sub_rand_nums) - call MPI_Barrier(MPI_COMM_WORLD, ierror) - call MPI_FINALIZE(ierror) + call MPI_Barrier(MPI_COMM_WORLD) + call MPI_FINALIZE() end program main diff --git a/tutorials/mpi-fortran/code/avg.f90 b/tutorials/mpi-fortran/code/avg.f90 index 4058893..6642721 100644 --- a/tutorials/mpi-fortran/code/avg.f90 +++ b/tutorials/mpi-fortran/code/avg.f90 @@ -25,7 +25,7 @@ end function compute_avg end module subs program main - use mpi + use mpi_f08 use iso_fortran_env, only: error_unit use subs @@ -34,7 +34,7 @@ program main integer :: num_args character(12) :: arg integer :: num_elements_per_proc - integer :: world_size, world_rank, ierror + integer :: world_size, world_rank real :: r, sub_avg, avg, original_data_avg real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) @@ -53,10 +53,10 @@ program main ! Throw away first rand value r = rand() - call MPI_INIT(ierror) + call MPI_INIT() - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) ! Create a random array of elements on the root process. Its total ! size will be the number of elements per process times the number @@ -69,7 +69,7 @@ program main allocate(sub_rand_nums(num_elements_per_proc)) call MPI_Scatter(rand_nums, num_elements_per_proc, MPI_FLOAT, sub_rand_nums, & - num_elements_per_proc, MPI_FLOAT, 0, MPI_COMM_WORLD, ierror) + num_elements_per_proc, MPI_FLOAT, 0, MPI_COMM_WORLD) ! Compute the average of your subset sub_avg = compute_avg(sub_rand_nums, num_elements_per_proc) @@ -78,7 +78,7 @@ program main if (world_rank .eq. 0) then allocate(sub_avgs(world_size)) end if - call MPI_Gather(sub_avg, 1, MPI_FLOAT, sub_avgs, 1, MPI_FLOAT, 0, MPI_COMM_WORLD, ierror) + call MPI_Gather(sub_avg, 1, MPI_FLOAT, sub_avgs, 1, MPI_FLOAT, 0, MPI_COMM_WORLD) ! Now that we have all of the partial averages on the root, compute the ! total average of all numbers. Since we are assuming each process computed @@ -99,7 +99,7 @@ program main end if deallocate(sub_rand_nums) - call MPI_Barrier(MPI_COMM_WORLD, ierror) - call MPI_FINALIZE(ierror) + call MPI_Barrier(MPI_COMM_WORLD) + call MPI_FINALIZE() end program main diff --git a/tutorials/mpi-fortran/code/check_status.f90 b/tutorials/mpi-fortran/code/check_status.f90 index 0378642..7951525 100644 --- a/tutorials/mpi-fortran/code/check_status.f90 +++ b/tutorials/mpi-fortran/code/check_status.f90 @@ -1,19 +1,19 @@ program check_status - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror + integer :: world_rank, world_size integer, parameter :: MAX_NUMBERS=100 integer :: numbers(MAX_NUMBERS) integer :: number_amount - integer :: recv_status(MPI_STATUS_SIZE) + type(MPI_Status) :: recv_status real :: r - call MPI_INIT(ierror) - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_INIT() + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) if (world_rank .eq. 0) then @@ -26,23 +26,23 @@ program check_status number_amount = int(rand() * real(MAX_NUMBERS)) ! Send the amount of integers to process one call MPI_SEND(numbers, number_amount, MPI_INT, 1, 9, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) print '("0 sent ", I0, " numbers to 1")', number_amount else if (world_rank .eq. 1) then ! Receive at most MAX_NUMBERS from process zero call MPI_RECV(numbers, MAX_NUMBERS, MPI_INT, 0, 9, & - MPI_COMM_WORLD, recv_status, ierror) + MPI_COMM_WORLD, recv_status) ! After receiving the message, check the status to determine how many ! numbers were actually received - call MPI_Get_count(recv_status, MPI_INT, number_amount, ierror) + call MPI_Get_count(recv_status, MPI_INT, number_amount) ! Print off the amount of numbers, and also print additional information ! in the status object print '("1 received ", I0, " numbers from 0. Message source = ", I0, ", tag = ", I0)', & - number_amount , recv_status(MPI_SOURCE) , recv_status(MPI_TAG) + number_amount , recv_status%MPI_SOURCE , recv_status%MPI_TAG end if - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD) - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program diff --git a/tutorials/mpi-fortran/code/comm_groups.f90 b/tutorials/mpi-fortran/code/comm_groups.f90 index 0f3468a..e2545bc 100644 --- a/tutorials/mpi-fortran/code/comm_groups.f90 +++ b/tutorials/mpi-fortran/code/comm_groups.f90 @@ -1,51 +1,51 @@ program main - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror - integer :: world_group, prime_group - integer :: prime_comm + integer :: world_rank, world_size + type(MPI_Group) :: world_group, prime_group + type(MPI_Comm) :: prime_comm integer, parameter :: n = 7 integer :: ranks(n) integer :: prime_rank, prime_size - call MPI_Init(ierror) + call MPI_Init() ! Get the rank and size in the original communicator - call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierror) - call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, world_rank) + call MPI_Comm_size(MPI_COMM_WORLD, world_size) ! Get the group of processes in MPI_COMM_WORLD - call MPI_Comm_group(MPI_COMM_WORLD, world_group, ierror) + call MPI_Comm_group(MPI_COMM_WORLD, world_group) ranks = [1, 2, 3, 5, 7, 11, 13] ! Construct a group containing all of the prime ranks in world_group - call MPI_Group_incl(world_group, 7, ranks, prime_group, ierror) + call MPI_Group_incl(world_group, 7, ranks, prime_group) ! Create a new communicator based on the group - call MPI_Comm_create_group(MPI_COMM_WORLD, prime_group, 0, prime_comm, ierror) + call MPI_Comm_create_group(MPI_COMM_WORLD, prime_group, 0, prime_comm) prime_rank = -1 prime_size = -1 ! If this rank isn't in the new communicator, it will be MPI_COMM_NULL ! Using MPI_COMM_NULL for MPI_Comm_rank or MPI_Comm_size is erroneous if (MPI_COMM_NULL .ne. prime_comm) then - call MPI_Comm_rank(prime_comm, prime_rank, ierror) - call MPI_Comm_size(prime_comm, prime_size, ierror) + call MPI_Comm_rank(prime_comm, prime_rank) + call MPI_Comm_size(prime_comm, prime_size) end if print '("WORLD RANK/SIZE: ", I0, "/", I0, " --- PRIME RANK/SIZE: ", I0, "/", I0)', & world_rank, world_size, prime_rank, prime_size - call MPI_Group_free(world_group, ierror) - call MPI_Group_free(prime_group, ierror) + call MPI_Group_free(world_group) + call MPI_Group_free(prime_group) if (MPI_COMM_NULL .ne. prime_comm) then - call MPI_Comm_free(prime_comm, ierror) + call MPI_Comm_free(prime_comm) end if - call MPI_Finalize(ierror) + call MPI_Finalize() end program main diff --git a/tutorials/mpi-fortran/code/comm_split.f90 b/tutorials/mpi-fortran/code/comm_split.f90 index 4a1d209..3551ab4 100644 --- a/tutorials/mpi-fortran/code/comm_split.f90 +++ b/tutorials/mpi-fortran/code/comm_split.f90 @@ -1,32 +1,32 @@ program main - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror + integer :: world_rank, world_size integer :: color - integer :: row_comm + type(MPI_Comm) :: row_comm integer :: row_rank, row_size - call MPI_INIT(ierror) + call MPI_INIT() ! Get the rank and size in the original communicator - call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierror) - call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, world_rank) + call MPI_Comm_size(MPI_COMM_WORLD, world_size) color = world_rank / 4 ! Determine color based on row ! Split the communicator based on the color and use the original rank for ordering - call MPI_Comm_split(MPI_COMM_WORLD, color, world_rank, row_comm, ierror) + call MPI_Comm_split(MPI_COMM_WORLD, color, world_rank, row_comm) - call MPI_Comm_rank(row_comm, row_rank, ierror) - call MPI_Comm_size(row_comm, row_size, ierror) + call MPI_Comm_rank(row_comm, row_rank) + call MPI_Comm_size(row_comm, row_size) print '("WORLD RANK/SIZE: ", I0, "/", I0, " --- ROW RANK/SIZE: ", I0, "/", I0)', & world_rank, world_size, row_rank, row_size - call MPI_Comm_free(row_comm, ierror) + call MPI_Comm_free(row_comm) - call MPI_Finalize(ierror) + call MPI_Finalize() end program main diff --git a/tutorials/mpi-fortran/code/compare_bcast.f90 b/tutorials/mpi-fortran/code/compare_bcast.f90 index 24a8be2..9af8bb2 100644 --- a/tutorials/mpi-fortran/code/compare_bcast.f90 +++ b/tutorials/mpi-fortran/code/compare_bcast.f90 @@ -1,5 +1,10 @@ +module subs + use mpi_f08 +contains subroutine my_bcast(data, count, datatype, root, communicator, ierror) - integer, intent (in) :: count, root, communicator, datatype + integer, intent (in) :: count, root + type(MPI_Comm), intent (in) :: communicator + type(MPI_Datatype), intent (in) :: datatype integer, intent (inout) :: data(count) integer, intent (out) :: ierror @@ -21,10 +26,12 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) end if end subroutine my_bcast +end module subs program main - use mpi + use mpi_f08 use iso_fortran_env, only: error_unit + use subs, only: my_bcast implicit none @@ -48,9 +55,9 @@ program main read (args(1), *) num_elements read (args(2), *) num_trials - call MPI_INIT(ierror) + call MPI_INIT() - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) total_my_bcast_time = 0.0 total_mpi_bcast_time = 0.0 @@ -60,18 +67,18 @@ program main do i = 1, num_trials ! Time my_bcast ! Synchronize before starting timing - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD) total_my_bcast_time = total_my_bcast_time - MPI_Wtime() call my_bcast(data, num_elements, MPI_INT, 0, MPI_COMM_WORLD, ierror) ! Synchronize again before obtaining final time - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD) total_my_bcast_time = total_my_bcast_time + MPI_Wtime() ! Time MPI_Bcast - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD) total_mpi_bcast_time = total_mpi_bcast_time - MPI_Wtime() call MPI_Bcast(data, num_elements, MPI_INT, 0, MPI_COMM_WORLD, ierror) - call MPI_Barrier(MPI_COMM_WORLD, ierror) + call MPI_Barrier(MPI_COMM_WORLD) total_mpi_bcast_time = total_mpi_bcast_time + MPI_Wtime() end do @@ -84,6 +91,6 @@ program main ! Finalize the MPI environment - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program diff --git a/tutorials/mpi-fortran/code/mpi_hello_world.f90 b/tutorials/mpi-fortran/code/mpi_hello_world.f90 index 979a797..b2ab05f 100644 --- a/tutorials/mpi-fortran/code/mpi_hello_world.f90 +++ b/tutorials/mpi-fortran/code/mpi_hello_world.f90 @@ -1,5 +1,5 @@ program hello_world_mpi - use mpi + use mpi_f08 implicit none diff --git a/tutorials/mpi-fortran/code/my_bcast.f90 b/tutorials/mpi-fortran/code/my_bcast.f90 index 79d1c7b..240248d 100644 --- a/tutorials/mpi-fortran/code/my_bcast.f90 +++ b/tutorials/mpi-fortran/code/my_bcast.f90 @@ -1,5 +1,10 @@ +module subs + use mpi_f08 +contains subroutine my_bcast(data, count, datatype, root, communicator, ierror) - integer, intent (in) :: count, root, communicator, datatype + integer, intent (in) :: count, root + type(MPI_Comm), intent (in) :: communicator + type(MPI_Datatype), intent (in) :: datatype integer, intent (inout) :: data(count) integer, intent (out) :: ierror @@ -21,17 +26,19 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) end if end subroutine my_bcast +end module subs program main - use mpi + use mpi_f08 + use subs, only: my_bcast implicit none integer :: world_rank, ierror integer :: data(1) - call MPI_INIT(ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_INIT() + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) if (world_rank .eq. 0) then data = 100 @@ -44,6 +51,6 @@ program main end if ! Finalize the MPI environment - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program diff --git a/tutorials/mpi-fortran/code/ping_pong.f90 b/tutorials/mpi-fortran/code/ping_pong.f90 index 88c9cbb..d15365e 100644 --- a/tutorials/mpi-fortran/code/ping_pong.f90 +++ b/tutorials/mpi-fortran/code/ping_pong.f90 @@ -1,17 +1,17 @@ program ping_pong - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror + integer :: world_rank, world_size integer :: partner_rank integer :: ping_pong_count, ping_pong_limit - integer :: recv_status(MPI_STATUS_SIZE) + type(MPI_Status) :: recv_status - call MPI_INIT(ierror) - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_INIT() + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) ping_pong_count = 0 ping_pong_limit = 10 @@ -23,17 +23,17 @@ program ping_pong ! Increment the ping pong count before you send it ping_pong_count = ping_pong_count + 1 call MPI_SEND(ping_pong_count, 1, MPI_INT, partner_rank, 0, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) print '(I0, " sent and incremented ping_pong_count ", I0, " to ", I0)', & world_rank, ping_pong_count, partner_rank else call MPI_RECV(ping_pong_count, 1, MPI_INT, partner_rank, 0, & - MPI_COMM_WORLD, recv_status, ierror) + MPI_COMM_WORLD, recv_status) print '(I0, " received ping_pong_count ", I0, " from ", I0)', & world_rank, ping_pong_count, partner_rank end if end do - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program diff --git a/tutorials/mpi-fortran/code/probe.f90 b/tutorials/mpi-fortran/code/probe.f90 index 2d19047..359f57d 100644 --- a/tutorials/mpi-fortran/code/probe.f90 +++ b/tutorials/mpi-fortran/code/probe.f90 @@ -1,19 +1,19 @@ program probe - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror + integer :: world_rank, world_size integer, parameter :: MAX_NUMBERS=100 integer, allocatable :: numbers(:) integer :: number_amount - integer :: recv_status(MPI_STATUS_SIZE) + type(MPI_Status) :: recv_status real :: r - call MPI_INIT(ierror) - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_INIT() + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) if (world_rank .eq. 0) then @@ -27,27 +27,27 @@ program probe allocate(numbers(MAX_NUMBERS)) ! Send the random amount of integers to process one call MPI_SEND(numbers, number_amount, MPI_INT, 1, 0, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) print '("0 sent ", I0, " numbers to 1")', number_amount else if (world_rank .eq. 1) then ! Probe for an incoming message from process zero - call MPI_PROBE(0, 0, MPI_COMM_WORLD, recv_status, ierror) + call MPI_PROBE(0, 0, MPI_COMM_WORLD, recv_status) ! When probe returns, the status object has the size and other ! attributes of the incoming message. Get the message size - call MPI_Get_count(recv_status, MPI_INT, number_amount, ierror) + call MPI_Get_count(recv_status, MPI_INT, number_amount) ! Allocate a buffer to hold the incoming numbers allocate(numbers(number_amount)) ! Now receive the message with the allocated buffer call MPI_RECV(numbers, number_amount, MPI_INT, 0, 0, & - MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror) + MPI_COMM_WORLD, MPI_STATUS_IGNORE) print '("1 dynamically received ", I0, " numbers from 0.")', & number_amount deallocate(numbers) end if - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program diff --git a/tutorials/mpi-fortran/code/reduce_avg.f90 b/tutorials/mpi-fortran/code/reduce_avg.f90 index 391031b..473578e 100644 --- a/tutorials/mpi-fortran/code/reduce_avg.f90 +++ b/tutorials/mpi-fortran/code/reduce_avg.f90 @@ -16,7 +16,7 @@ end subroutine create_rand_nums end module subs program main - use mpi + use mpi_f08 use iso_fortran_env, only: error_unit use subs @@ -25,7 +25,7 @@ program main integer :: num_args character(12) :: arg integer :: num_elements_per_proc - integer :: world_size, world_rank, ierror + integer :: world_size, world_rank real :: r, local_sum, global_sum real, allocatable :: rand_nums(:) @@ -39,10 +39,10 @@ program main call get_command_argument(1, arg) read (arg, *) num_elements_per_proc - call MPI_INIT(ierror) + call MPI_INIT() - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) ! Create a random array of elements on all processes. call srand(time()) ! Seed the random number generator to get different results each time for each processor @@ -61,7 +61,7 @@ program main ! Reduce all of the local sums into the global sum call MPI_Reduce(local_sum, global_sum, 1, MPI_FLOAT, MPI_SUM, 0, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) ! Print the result if (world_rank .eq. 0) then @@ -72,7 +72,7 @@ program main ! Clean up deallocate(rand_nums) - call MPI_Barrier(MPI_COMM_WORLD, ierror) - call MPI_FINALIZE(ierror) + call MPI_Barrier(MPI_COMM_WORLD) + call MPI_FINALIZE() end program main diff --git a/tutorials/mpi-fortran/code/reduce_std.f90 b/tutorials/mpi-fortran/code/reduce_std.f90 index b9e1201..7490bf0 100644 --- a/tutorials/mpi-fortran/code/reduce_std.f90 +++ b/tutorials/mpi-fortran/code/reduce_std.f90 @@ -16,7 +16,7 @@ end subroutine create_rand_nums end module subs program main - use mpi + use mpi_f08 use iso_fortran_env, only: error_unit use subs @@ -25,7 +25,7 @@ program main integer :: num_args character(12) :: arg integer :: num_elements_per_proc - integer :: world_size, world_rank, ierror + integer :: world_size, world_rank real :: r, local_sum, global_sum, mean, local_sq_diff, global_sq_diff, stddev real, allocatable :: rand_nums(:) integer :: i @@ -40,10 +40,10 @@ program main call get_command_argument(1, arg) read (arg, *) num_elements_per_proc - call MPI_INIT(ierror) + call MPI_INIT() - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) ! Create a random array of elements on all processes. call srand(time()) ! Seed the random number generator of processes uniquely @@ -58,7 +58,7 @@ program main ! Reduce all of the local sums into the global sum in order to ! calculate the mean call MPI_Allreduce(local_sum, global_sum, 1, MPI_FLOAT, MPI_SUM, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) mean = global_sum / real(num_elements_per_proc * world_size) ! Compute the local sum of the squared differences from the mean @@ -70,7 +70,7 @@ program main ! Reduce the global sum of the squared differences to the root process ! and print off the answer call MPI_Reduce(local_sq_diff, global_sq_diff, 1, MPI_FLOAT, MPI_SUM, 0, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) ! The standard deviation is the square root of the mean of the squared ! differences @@ -83,7 +83,7 @@ program main ! Clean up deallocate(rand_nums) - call MPI_Barrier(MPI_COMM_WORLD, ierror) - call MPI_FINALIZE(ierror) + call MPI_Barrier(MPI_COMM_WORLD) + call MPI_FINALIZE() end program main diff --git a/tutorials/mpi-fortran/code/ring.f90 b/tutorials/mpi-fortran/code/ring.f90 index f14ac8a..f751e4e 100644 --- a/tutorials/mpi-fortran/code/ring.f90 +++ b/tutorials/mpi-fortran/code/ring.f90 @@ -1,21 +1,21 @@ program ring - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror + integer :: world_rank, world_size integer :: token - integer :: recv_status(MPI_STATUS_SIZE) + type(MPI_Status) :: recv_status - call MPI_INIT(ierror) - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_INIT() + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) if (world_rank .ne. 0) then call MPI_RECV(token, 1, MPI_INT, world_rank - 1, 0, & - MPI_COMM_WORLD, recv_status, ierror) + MPI_COMM_WORLD, recv_status) print '("Process ", I0, " received token ", I0, " from process ", I0)', & world_rank, token, world_rank - 1 else @@ -24,16 +24,16 @@ program ring end if call MPI_SEND(token, 1, MPI_INT, mod(world_rank + 1, world_size), 0, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) ! Now process 0 can receive from the last process. if (world_rank .eq. 0) then call MPI_RECV(token, 1, MPI_INT, world_size - 1, 0, & - MPI_COMM_WORLD, recv_status, ierror) + MPI_COMM_WORLD, recv_status) print '("Process ", I0, " received token ", I0, " from process ", I0)', & world_rank, token, world_size - 1 end if - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program diff --git a/tutorials/mpi-fortran/code/send_recv.f90 b/tutorials/mpi-fortran/code/send_recv.f90 index e9eb8d2..f821273 100644 --- a/tutorials/mpi-fortran/code/send_recv.f90 +++ b/tutorials/mpi-fortran/code/send_recv.f90 @@ -1,27 +1,27 @@ program send_recv - use mpi + use mpi_f08 implicit none - integer :: world_rank, world_size, ierror + integer :: world_rank, world_size integer :: num - integer :: recv_status(MPI_STATUS_SIZE) + type(MPI_Status) :: recv_status - call MPI_INIT(ierror) - call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierror) + call MPI_INIT() + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) if (world_rank .eq. 0) then num = -1 call MPI_SEND(num, 1, MPI_INT, 1, 0, & - MPI_COMM_WORLD, ierror) + MPI_COMM_WORLD) else if (world_rank .eq. 1) then call MPI_RECV(num, 1, MPI_INT, 0, 0, & - MPI_COMM_WORLD, recv_status, ierror) + MPI_COMM_WORLD, recv_status) print '("Process 1 received number ", I0, " from process 0")', num end if - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program From e35214353929a6910d605197be7f9ca701f4d321 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 12 Oct 2023 12:10:46 +0100 Subject: [PATCH 12/16] Bring fortran Hello World more in line with C code --- .../mpi-fortran/code/mpi_hello_world.f90 | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/tutorials/mpi-fortran/code/mpi_hello_world.f90 b/tutorials/mpi-fortran/code/mpi_hello_world.f90 index b2ab05f..f5cb97b 100644 --- a/tutorials/mpi-fortran/code/mpi_hello_world.f90 +++ b/tutorials/mpi-fortran/code/mpi_hello_world.f90 @@ -3,28 +3,28 @@ program hello_world_mpi implicit none - integer :: process_rank, size_of_cluster, ierror - integer :: resultlen + integer :: world_rank, world_size + integer :: name_len - character (len=MPI_MAX_PROCESSOR_NAME) :: process_name + character (len=MPI_MAX_PROCESSOR_NAME) :: processor_name ! Initialize the MPI environment - call MPI_INIT(ierror) + call MPI_INIT() ! Get the number of processes - call MPI_COMM_SIZE(MPI_COMM_WORLD, size_of_cluster, ierror) + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) ! Get the rank of the process - call MPI_COMM_RANK(MPI_COMM_WORLD, process_rank, ierror) + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) ! Get the name of the processor - call MPI_GET_PROCESSOR_NAME(process_name, resultlen, ierror) + call MPI_GET_PROCESSOR_NAME(processor_name, name_len) ! Print off an hello world message - write (*,*) 'Hello World from processor ', trim(process_name), ' rank ', & - process_rank, 'of ', size_of_cluster, 'processors' + print '("Hello world from processor ", A, ", rank ", I0, " out of ", I0, " processors")', & + processor_name(:name_len), world_rank, world_size ! Finalize the MPI environment - call MPI_FINALIZE(ierror) + call MPI_FINALIZE() end program From e04c165f7c5d98cfcc37def303b61fdc166d4081 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 12 Oct 2023 12:11:29 +0100 Subject: [PATCH 13/16] Add MPI Fortran tutorial --- tutorials/mpi-fortran/index.md | 161 +++++++++++++++++++++++++++++++++ 1 file changed, 161 insertions(+) create mode 100644 tutorials/mpi-fortran/index.md diff --git a/tutorials/mpi-fortran/index.md b/tutorials/mpi-fortran/index.md new file mode 100644 index 0000000..803b137 --- /dev/null +++ b/tutorials/mpi-fortran/index.md @@ -0,0 +1,161 @@ +--- +layout: post +title: Using MPI with Fortran +author: Stephen Cook +categories: Beginner MPI +tags: +translations: +redirect_from: '/mpi-fortran/' +--- + +The MPI specification defines bindings for use within Fortran, a programming language frequently used for scientific computing. +In this tutorial, we shall see some of the specifics for using MPI with Fortran, focussing on the similarities and differences compared to the C binding covered in the other tutorials. + +> **Note** - Fortran versions of most of the MPI example code is provided on [GitHub]({{ site.github.repo }}) under [tutorials/mpi-fortran/code]({{ site.github.code }}/tutorials/mpi-fortran/code). + +## Fortran Hello World code example + +We shall first have a look at the Fortran 2008 version of a Hello World located in [mpi_hello_world.f90]({{ site.github.code }}/tutorials/mpi-fortran/code/mpi_hello_world.f90). + +```fortran +program hello_world_mpi + use mpi_f08 + + implicit none + + integer :: world_rank, world_size + integer :: name_len + + character (len=MPI_MAX_PROCESSOR_NAME) :: processor_name + + ! Initialize the MPI environment + call MPI_INIT() + + ! Get the number of processes + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + + ! Get the rank of the process + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) + + ! Get the name of the processor + call MPI_GET_PROCESSOR_NAME(processor_name, name_len) + + ! Print off an hello world message + print '("Hello world from processor ", A, ", rank ", I0, " out of ", I0, " processors")', & + processor_name(:name_len), world_rank, world_size + + ! Finalize the MPI environment + call MPI_FINALIZE() + +end program +``` + +Comparing this with the equivalent C code in [mpi_hello_world.c]({{ site.github.code }}/tutorials/mpi-hello-world/code/mpi_hello_world.c): + +```c +#include +#include + +int main(int argc, char** argv) { + // Initialize the MPI environment + MPI_Init(NULL, NULL); + + // Get the number of processes + int world_size; + MPI_Comm_size(MPI_COMM_WORLD, &world_size); + + // Get the rank of the process + int world_rank; + MPI_Comm_rank(MPI_COMM_WORLD, &world_rank); + + // Get the name of the processor + char processor_name[MPI_MAX_PROCESSOR_NAME]; + int name_len; + MPI_Get_processor_name(processor_name, &name_len); + + // Print off a hello world message + printf("Hello world from processor %s, rank %d out of %d processors\n", + processor_name, world_rank, world_size); + + // Finalize the MPI environment. + MPI_Finalize(); +} +``` + +We see many similarities but a few important differences. + +## Importing and initializing MPI + +In order to make MPI calls from within a Fortran program, the library must be imported and then initialized. + +The modern implementation of MPI was introduced with MPI 3.0 and Fortran 2008, and is imported into the program with + +```fortran +USE mpi_f08 +``` + +The fortran binding to the MPI routines are implemented as subroutines, and require the syntax + +```fortran +call MPI_XXXXXX() +``` + +> **Note** - Unlike C, Fortran is case insensitive. We adopt the convention of using all-capital names of the MPI routines. + +As an example, the first few lines of a fortran MPI program may look like this: + +```fortran +use mpi_f08 +implicit none +call MPI_INIT() +``` + +All the Fortran routines have an optional argument to return an error-code, so the above could could also be + +```fortran +use mpi_f08 +implicit none +integer :: ierror +call MPI_INIT(ierror) +``` + +The routine `MPI_INIT` has no required arguments and an error code can be returned as an optional argument. +Compare this with the C function `MPI_Init` which has two required arguments (the number of command-line arguments and a list of these as character arrays) and can optionally give the error code as the return value. + +## Other MPI routines + +Despite the differences in arguments required by the C and Fortran versions of `MPI_Init`, most other Fortran MPI routines share similar interfaces as the C implementations. +Again, the Fortran 2008 routines all end in the optional argument `IERROR`. + +```fortran +program hello_world_mpi + use mpi_f08 + integer :: world_size + call MPI_INIT() + + ! Get the number of processes + call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) + ! Alternatively: + ! MPI_COMM_SIZE(MPI_COMM_WORLD, world_size, ierror) +``` + +Fortran versions of most of the C MPI example code from these tutorials has been translated to Fortran and is provided on [GitHub]({{ site.github.repo }}) under [tutorials/mpi-fortran/code]({{ site.github.code }}/tutorials/mpi-fortran/code). +These have mostly been written to mirror the C versions, with some Fortran-specific functionality added where it does not impact the MPI code (such as using the fortran function `sum` instead of performing a summation in a loop). + +## Older MPI implementations + +Prior to the introduction of `mpi_f08`, the library was imported with the syntax + +```fortran +USE mpi +``` + +or the Fortran77 compatible + +```fortran +INCLUDE 'mpif.h' +``` + +In the older versions of the interface (both `mpi` and `mpif.h`), most of the arguments such as the communicator object or the probe return status are integers or arrays of integers. +In the newer syntax, these objects are implemented as custom typedefs (as in the C interface) leading to better compile-time argument checking. +There is also an error code returned with all MPI calls, which is a required argument in the older versions, and an optional argument in the modern implementation. From a467a2824a3a1e013fbe221d77dea03d5c4a91ac Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 30 Nov 2023 09:41:55 +0000 Subject: [PATCH 14/16] Remove module blocks and refactor RNG calls Module blocks removed in favor of external functions/subroutines and interface blocks. Random number functions `srand` and `rand` replaced by more standard `random_seed` and `random_number` calls. --- tutorials/mpi-fortran/code/all_avg.f90 | 54 +++++++++------------ tutorials/mpi-fortran/code/avg.f90 | 52 ++++++++------------ tutorials/mpi-fortran/code/check_status.f90 | 8 ++- tutorials/mpi-fortran/code/probe.f90 | 8 ++- tutorials/mpi-fortran/code/reduce_avg.f90 | 25 ++-------- tutorials/mpi-fortran/code/reduce_std.f90 | 25 ++-------- 6 files changed, 55 insertions(+), 117 deletions(-) diff --git a/tutorials/mpi-fortran/code/all_avg.f90 b/tutorials/mpi-fortran/code/all_avg.f90 index b58cf8f..8dc44a5 100644 --- a/tutorials/mpi-fortran/code/all_avg.f90 +++ b/tutorials/mpi-fortran/code/all_avg.f90 @@ -1,41 +1,22 @@ -module subs - implicit none -contains - subroutine create_rand_nums(rand_nums, num_elements) - ! Creates an array of random numbers. Each number has a value from 0 - 1 - integer, intent(in) :: num_elements - real, intent(out) :: rand_nums(num_elements) - - integer :: i - - do i = 1, num_elements - rand_nums(i) = rand() - end do - - end subroutine create_rand_nums - - function compute_avg(array, num_elements) - ! Computes the average of an array of numbers - real :: compute_avg - integer, intent(in) :: num_elements - real, intent(in) :: array(num_elements) - - compute_avg = sum(array) / real(num_elements) - end function compute_avg -end module subs - program main use mpi_f08 use iso_fortran_env, only: error_unit - use subs implicit none + interface + function compute_avg(array, num_elements) + real :: compute_avg + integer, intent(in) :: num_elements + real, intent(in) :: array(num_elements) + end function compute_avg + end interface + integer :: num_args character(12) :: arg integer :: num_elements_per_proc integer :: world_size, world_rank - real :: r, sub_avg, avg + real :: sub_avg, avg real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) num_args = command_argument_count() @@ -49,9 +30,7 @@ program main read (arg, *) num_elements_per_proc ! Seed the random number generator to get different results each time - call srand(time()) - ! Throw away first rand value - r = rand() + call random_seed() call MPI_INIT() @@ -63,7 +42,7 @@ program main ! of processes if (world_rank .eq. 0) then allocate(rand_nums(num_elements_per_proc * world_size)) - call create_rand_nums(rand_nums, num_elements_per_proc * world_size) + call random_number(rand_nums) end if allocate(sub_rand_nums(num_elements_per_proc)) @@ -96,3 +75,14 @@ program main call MPI_FINALIZE() end program main + + +function compute_avg(array, num_elements) + ! Computes the average of an array of numbers + implicit none + real :: compute_avg + integer, intent(in) :: num_elements + real, intent(in) :: array(num_elements) + + compute_avg = sum(array) / real(num_elements) +end function compute_avg diff --git a/tutorials/mpi-fortran/code/avg.f90 b/tutorials/mpi-fortran/code/avg.f90 index 6642721..b98a218 100644 --- a/tutorials/mpi-fortran/code/avg.f90 +++ b/tutorials/mpi-fortran/code/avg.f90 @@ -1,41 +1,23 @@ -module subs - implicit none -contains - subroutine create_rand_nums(rand_nums, num_elements) - ! Creates an array of random numbers. Each number has a value from 0 - 1 - integer, intent(in) :: num_elements - real, intent(out) :: rand_nums(num_elements) - - integer :: i - - do i = 1, num_elements - rand_nums(i) = rand() - end do - - end subroutine create_rand_nums - - function compute_avg(array, num_elements) - ! Computes the average of an array of numbers - real :: compute_avg - integer, intent(in) :: num_elements - real, intent(in) :: array(num_elements) - - compute_avg = sum(array) / real(num_elements) - end function compute_avg -end module subs program main use mpi_f08 use iso_fortran_env, only: error_unit - use subs implicit none + interface + function compute_avg(array, num_elements) + real :: compute_avg + integer, intent(in) :: num_elements + real, intent(in) :: array(num_elements) + end function + end interface + integer :: num_args character(12) :: arg integer :: num_elements_per_proc integer :: world_size, world_rank - real :: r, sub_avg, avg, original_data_avg + real :: sub_avg, avg, original_data_avg real, allocatable :: rand_nums(:), sub_rand_nums(:), sub_avgs(:) num_args = command_argument_count() @@ -49,9 +31,7 @@ program main read (arg, *) num_elements_per_proc ! Seed the random number generator to get different results each time - call srand(time()) - ! Throw away first rand value - r = rand() + call random_seed() call MPI_INIT() @@ -63,7 +43,7 @@ program main ! of processes if (world_rank .eq. 0) then allocate(rand_nums(num_elements_per_proc * world_size)) - call create_rand_nums(rand_nums, num_elements_per_proc * world_size) + call random_number(rand_nums) end if allocate(sub_rand_nums(num_elements_per_proc)) @@ -103,3 +83,13 @@ program main call MPI_FINALIZE() end program main + +function compute_avg(array, num_elements) + ! Computes the average of an array of numbers + implicit none + real :: compute_avg + integer, intent(in) :: num_elements + real, intent(in) :: array(num_elements) + + compute_avg = sum(array) / real(num_elements) +end function compute_avg diff --git a/tutorials/mpi-fortran/code/check_status.f90 b/tutorials/mpi-fortran/code/check_status.f90 index 7951525..100196e 100644 --- a/tutorials/mpi-fortran/code/check_status.f90 +++ b/tutorials/mpi-fortran/code/check_status.f90 @@ -18,12 +18,10 @@ program check_status if (world_rank .eq. 0) then ! Pick a random amount of integers to send to process one - call srand(time()) + call random_seed() - ! Throw away first value - r = rand() - - number_amount = int(rand() * real(MAX_NUMBERS)) + call random_number(r) + number_amount = int(r * real(MAX_NUMBERS)) ! Send the amount of integers to process one call MPI_SEND(numbers, number_amount, MPI_INT, 1, 9, & MPI_COMM_WORLD) diff --git a/tutorials/mpi-fortran/code/probe.f90 b/tutorials/mpi-fortran/code/probe.f90 index 359f57d..854b894 100644 --- a/tutorials/mpi-fortran/code/probe.f90 +++ b/tutorials/mpi-fortran/code/probe.f90 @@ -18,12 +18,10 @@ program probe if (world_rank .eq. 0) then ! Pick a random amount of integers to send to process one - call srand(time()) + call random_seed() - ! Throw away first value - r = rand() - - number_amount = int(rand() * real(MAX_NUMBERS)) + call random_number(r) + number_amount = int(r * real(MAX_NUMBERS)) allocate(numbers(MAX_NUMBERS)) ! Send the random amount of integers to process one call MPI_SEND(numbers, number_amount, MPI_INT, 1, 0, & diff --git a/tutorials/mpi-fortran/code/reduce_avg.f90 b/tutorials/mpi-fortran/code/reduce_avg.f90 index 473578e..0803dbc 100644 --- a/tutorials/mpi-fortran/code/reduce_avg.f90 +++ b/tutorials/mpi-fortran/code/reduce_avg.f90 @@ -1,20 +1,3 @@ -module subs - implicit none -contains - subroutine create_rand_nums(rand_nums, num_elements) - ! Creates an array of random numbers. Each number has a value from 0 - 1 - integer, intent(in) :: num_elements - real, intent(out) :: rand_nums(num_elements) - - integer :: i - - do i = 1, num_elements - rand_nums(i) = rand() - end do - - end subroutine create_rand_nums -end module subs - program main use mpi_f08 use iso_fortran_env, only: error_unit @@ -26,7 +9,7 @@ program main character(12) :: arg integer :: num_elements_per_proc integer :: world_size, world_rank - real :: r, local_sum, global_sum + real :: local_sum, global_sum real, allocatable :: rand_nums(:) num_args = command_argument_count() @@ -45,11 +28,9 @@ program main call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) ! Create a random array of elements on all processes. - call srand(time()) ! Seed the random number generator to get different results each time for each processor - ! Throw away first rand value - r = rand() + call random_seed() ! Seed the random number generator to get different results each time for each processor allocate(rand_nums(num_elements_per_proc)) - call create_rand_nums(rand_nums, num_elements_per_proc) + call random_number(rand_nums) ! Sum the numbers locally local_sum = sum(rand_nums) diff --git a/tutorials/mpi-fortran/code/reduce_std.f90 b/tutorials/mpi-fortran/code/reduce_std.f90 index 7490bf0..1d6ad02 100644 --- a/tutorials/mpi-fortran/code/reduce_std.f90 +++ b/tutorials/mpi-fortran/code/reduce_std.f90 @@ -1,20 +1,3 @@ -module subs - implicit none -contains - subroutine create_rand_nums(rand_nums, num_elements) - ! Creates an array of random numbers. Each number has a value from 0 - 1 - integer, intent(in) :: num_elements - real, intent(out) :: rand_nums(num_elements) - - integer :: i - - do i = 1, num_elements - rand_nums(i) = rand() - end do - - end subroutine create_rand_nums -end module subs - program main use mpi_f08 use iso_fortran_env, only: error_unit @@ -26,7 +9,7 @@ program main character(12) :: arg integer :: num_elements_per_proc integer :: world_size, world_rank - real :: r, local_sum, global_sum, mean, local_sq_diff, global_sq_diff, stddev + real :: local_sum, global_sum, mean, local_sq_diff, global_sq_diff, stddev real, allocatable :: rand_nums(:) integer :: i @@ -46,11 +29,9 @@ program main call MPI_COMM_SIZE(MPI_COMM_WORLD, world_size) ! Create a random array of elements on all processes. - call srand(time()) ! Seed the random number generator of processes uniquely - ! Throw away first rand value - r = rand() + call random_seed() ! Seed the random number generator of processes uniquely allocate(rand_nums(num_elements_per_proc)) - call create_rand_nums(rand_nums, num_elements_per_proc) + call random_number(rand_nums) ! Sum the numbers locally local_sum = sum(rand_nums) From f23539c77045cb4eac1bfcb57d6bbfdacae2193d Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 30 Nov 2023 11:01:02 +0000 Subject: [PATCH 15/16] Update bcast examples with subroutines/interfaces --- tutorials/mpi-fortran/code/compare_bcast.f90 | 70 +++++++++++--------- tutorials/mpi-fortran/code/makefile | 3 +- tutorials/mpi-fortran/code/my_bcast.f90 | 70 +++++++++++--------- 3 files changed, 80 insertions(+), 63 deletions(-) diff --git a/tutorials/mpi-fortran/code/compare_bcast.f90 b/tutorials/mpi-fortran/code/compare_bcast.f90 index 9af8bb2..15e5172 100644 --- a/tutorials/mpi-fortran/code/compare_bcast.f90 +++ b/tutorials/mpi-fortran/code/compare_bcast.f90 @@ -1,39 +1,19 @@ -module subs - use mpi_f08 -contains -subroutine my_bcast(data, count, datatype, root, communicator, ierror) - integer, intent (in) :: count, root - type(MPI_Comm), intent (in) :: communicator - type(MPI_Datatype), intent (in) :: datatype - integer, intent (inout) :: data(count) - integer, intent (out) :: ierror - - integer :: world_rank, world_size - integer :: i - - call MPI_COMM_SIZE(communicator, world_size, ierror) - call MPI_COMM_RANK(communicator, world_rank, ierror) - - if (world_rank .eq. root) then - ! If we are the root process, send our data to everyone - do i = 0, world_size - 1 - if (i .ne. world_rank) then - call MPI_SEND(data, count, datatype, i, 0, communicator, ierror) - end if - end do - else - ! If we are a receiver process, receive the data from the root - call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) - end if -end subroutine my_bcast -end module subs - program main use mpi_f08 use iso_fortran_env, only: error_unit - use subs, only: my_bcast implicit none + interface + subroutine my_bcast(data, count, datatype, root, communicator, ierror) + import MPI_Comm, MPI_Datatype + implicit none + integer, intent (in) :: count, root + type(MPI_Comm), intent (in) :: communicator + type(MPI_Datatype), intent (in) :: datatype + integer, intent (inout) :: data(count) + integer, intent (out) :: ierror + end subroutine my_bcast + end interface integer :: num_args, num_elements, num_trials character(12) :: args(2) @@ -94,3 +74,31 @@ program main call MPI_FINALIZE() end program + +subroutine my_bcast(data, count, datatype, root, communicator, ierror) + use mpi_f08 + implicit none + integer, intent (in) :: count, root + type(MPI_Comm), intent (in) :: communicator + type(MPI_Datatype), intent (in) :: datatype + integer, intent (inout) :: data(count) + integer, intent (out) :: ierror + + integer :: world_rank, world_size + integer :: i + + call MPI_COMM_SIZE(communicator, world_size, ierror) + call MPI_COMM_RANK(communicator, world_rank, ierror) + + if (world_rank .eq. root) then + ! If we are the root process, send our data to everyone + do i = 0, world_size - 1 + if (i .ne. world_rank) then + call MPI_SEND(data, count, datatype, i, 0, communicator, ierror) + end if + end do + else + ! If we are a receiver process, receive the data from the root + call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) + end if +end subroutine my_bcast \ No newline at end of file diff --git a/tutorials/mpi-fortran/code/makefile b/tutorials/mpi-fortran/code/makefile index 53a7d7a..3cf5eb8 100644 --- a/tutorials/mpi-fortran/code/makefile +++ b/tutorials/mpi-fortran/code/makefile @@ -1,7 +1,6 @@ EXECS=mpi_hello_world send_recv ping_pong ring check_status probe \ my_bcast compare_bcast avg all_avg reduce_avg reduce_std \ comm_split comm_groups -MOD_FILES=subs.mod MPIF90?=mpif90 FFLAGS=-Wall @@ -50,4 +49,4 @@ comm_groups: comm_groups.f90 $(MPIF90) $(FFLAGS) comm_groups.f90 -o comm_groups clean: - rm -f $(EXECS) $(MOD_FILES) + rm -f $(EXECS) diff --git a/tutorials/mpi-fortran/code/my_bcast.f90 b/tutorials/mpi-fortran/code/my_bcast.f90 index 240248d..e0ef8d3 100644 --- a/tutorials/mpi-fortran/code/my_bcast.f90 +++ b/tutorials/mpi-fortran/code/my_bcast.f90 @@ -1,7 +1,45 @@ -module subs +program main use mpi_f08 -contains + + implicit none + + interface + subroutine my_bcast(data, count, datatype, root, communicator, ierror) + import MPI_Comm, MPI_Datatype + implicit none + integer, intent (in) :: count, root + type(MPI_Comm), intent (in) :: communicator + type(MPI_Datatype), intent (in) :: datatype + integer, intent (inout) :: data(count) + integer, intent (out) :: ierror + end subroutine my_bcast + end interface + + integer :: world_rank, ierror + integer :: data(1) + + call MPI_INIT() + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) + + if (world_rank .eq. 0) then + data = 100 + print '("Process 0 broadcasting data ", I0)', data + call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD, ierror) + else + call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD, ierror) + print '("Process ", I0, " received data ", I0, " from root process")', & + world_rank, data + end if + + ! Finalize the MPI environment + call MPI_FINALIZE() + +end program + + subroutine my_bcast(data, count, datatype, root, communicator, ierror) + use mpi_f08 + implicit none integer, intent (in) :: count, root type(MPI_Comm), intent (in) :: communicator type(MPI_Datatype), intent (in) :: datatype @@ -26,31 +64,3 @@ subroutine my_bcast(data, count, datatype, root, communicator, ierror) call MPI_RECV(data, count, datatype, root, 0, communicator, MPI_STATUS_IGNORE, ierror) end if end subroutine my_bcast -end module subs - -program main - use mpi_f08 - use subs, only: my_bcast - - implicit none - - integer :: world_rank, ierror - integer :: data(1) - - call MPI_INIT() - call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank) - - if (world_rank .eq. 0) then - data = 100 - print '("Process 0 broadcasting data ", I0)', data - call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD, ierror) - else - call my_bcast(data, 1, MPI_INT, 0, MPI_COMM_WORLD, ierror) - print '("Process ", I0, " received data ", I0, " from root process")', & - world_rank, data - end if - - ! Finalize the MPI environment - call MPI_FINALIZE() - -end program From 02d216c1640e104d4c5a545be10d290f0dae7010 Mon Sep 17 00:00:00 2001 From: "Stephen P. Cook" Date: Thu, 31 Jul 2025 15:17:23 +0100 Subject: [PATCH 16/16] Add MPI-Fortran to tutorials index --- tutorials.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tutorials.md b/tutorials.md index e477fbe..37a2d99 100644 --- a/tutorials.md +++ b/tutorials.md @@ -30,3 +30,6 @@ The tutorials assume that the reader has a basic knowledge of C, some C++, and L ## Groups and communicators * [Introduction to groups and communicators]({{ site.baseurl }}/tutorials/introduction-to-groups-and-communicators/) ([中文版]({{ site.baseurl }}/tutorials/introduction-to-groups-and-communicators/zh_cn)) + +## MPI and Fortran +* [Introduction and differences for MPI Fortran]({{ site.baseurl }}/tutorials/mpi-fortran/)