From a09191060e6c04d9dc867c1062b91e6c1ad8e97f Mon Sep 17 00:00:00 2001 From: Ben Hourahine Date: Mon, 15 Jun 2020 20:41:24 +0100 Subject: [PATCH 1/2] IETF aricle 19 naming suggestion --- doc/sphinx/about.rst | 2 +- external/fypp/README.rst | 2 +- lib/mpifx_allgatherv.fpp | 2 +- lib/mpifx_bcast.fpp | 6 +++--- lib/mpifx_comm.fpp | 8 ++++---- lib/mpifx_gather.fpp | 28 ++++++++++++++-------------- lib/mpifx_gatherv.fpp | 12 ++++++------ lib/mpifx_recv.fpp | 6 +++--- lib/mpifx_reduce.fpp | 8 ++++---- lib/mpifx_scatter.fpp | 24 ++++++++++++------------ lib/mpifx_scatterv.fpp | 22 +++++++++++----------- lib/mpifx_send.fpp | 6 +++--- test/test_bcast.f90 | 10 +++++----- test/test_gather.f90 | 12 ++++++------ test/test_gatherv.f90 | 24 ++++++++++++------------ test/test_scatter.f90 | 6 +++--- test/test_scatterv.f90 | 8 ++++---- test/test_send_recv.f90 | 6 +++--- 18 files changed, 96 insertions(+), 96 deletions(-) diff --git a/doc/sphinx/about.rst b/doc/sphinx/about.rst index a151bf0..4feff63 100644 --- a/doc/sphinx/about.rst +++ b/doc/sphinx/about.rst @@ -17,7 +17,7 @@ Additional to the object to be broadcasted and the communicator, you also - size of the array (which is redundant, as it is *known* at run-time) -- root node of the broadcast (setting it to the master node as default would +- root node of the broadcast (setting it to the lead node as default would be a definitely safe choice) - error flag (one could per default just omit it and rely on the program to stop diff --git a/external/fypp/README.rst b/external/fypp/README.rst index ef72a35..44bfd28 100644 --- a/external/fypp/README.rst +++ b/external/fypp/README.rst @@ -199,7 +199,7 @@ repository:: git clone https://github.com/aradi/fypp.git -and check out the `master` branch. +and check out the default main branch. The command line tool is a single stand-alone script. You can run it directly from the source folder :: diff --git a/lib/mpifx_allgatherv.fpp b/lib/mpifx_allgatherv.fpp index b64fe4c..55898bb 100644 --- a/lib/mpifx_allgatherv.fpp +++ b/lib/mpifx_allgatherv.fpp @@ -159,7 +159,7 @@ module mpifx_allgatherv_module !! !! write(*, *) mycomm%rank, "Send1 buffer:", send1(:) !! call mpifx_allgatherv(mycomm, send1, recv1, recvcounts) - !! if (mycomm%master) then + !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 !! end if !! diff --git a/lib/mpifx_bcast.fpp b/lib/mpifx_bcast.fpp index 6ce66d4..264c1fb 100644 --- a/lib/mpifx_bcast.fpp +++ b/lib/mpifx_bcast.fpp @@ -28,7 +28,7 @@ module mpifx_bcast_module !! integer :: buffer(3) !! !! call mycomm%init() - !! if (mycomm%master) then + !! if (mycomm%lead) then !! buffer(:) = [ 1, 2, 3 ] !! end if !! call mpifx_bcast(mycomm, buffer) @@ -61,7 +61,7 @@ contains !> Msg to be broadcasted on root and received on non-root nodes. ${TYPE}$ :: msg${RANKSUFFIX(RANK)}$ - !> Root node for the broadcast (default: mycomm%masterrank). + !> Root node for the broadcast (default: mycomm%leadrank). integer, intent(in), optional :: root !> Optional error handling flag. @@ -72,7 +72,7 @@ contains #:set SIZE = '1' if RANK == 0 else 'size(msg)' #:set COUNT = ('len(msg) * ' + SIZE if HASLENGTH else SIZE) - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) call mpi_bcast(msg, ${COUNT}$, ${MPITYPE}$, root0, mycomm%id, error0) call handle_errorflag(error0, "MPI_BCAST in mpifx_bcast_${SUFFIX}$", error) diff --git a/lib/mpifx_comm.fpp b/lib/mpifx_comm.fpp index fcf6306..eb3f5a1 100644 --- a/lib/mpifx_comm.fpp +++ b/lib/mpifx_comm.fpp @@ -12,8 +12,8 @@ module mpifx_comm_module integer :: id !< Communicator id. integer :: size !< Nr. of processes (size). integer :: rank !< Rank of the current process. - integer :: masterrank !< Index of the master node. - logical :: master !< True if current process is the master (rank == 0). + integer :: leadrank !< Index of the lead node. + logical :: lead !< True if current process is the lead (rank == 0). contains !> Initializes the MPI environment. procedure :: init => mpifx_comm_init @@ -50,8 +50,8 @@ contains if (error0 /= 0) then return end if - self%masterrank = 0 - self%master = (self%rank == self%masterrank) + self%leadrank = 0 + self%lead = (self%rank == self%leadrank) end subroutine mpifx_comm_init diff --git a/lib/mpifx_gather.fpp b/lib/mpifx_gather.fpp index 98593c2..b79bc2a 100644 --- a/lib/mpifx_gather.fpp +++ b/lib/mpifx_gather.fpp @@ -43,7 +43,7 @@ module mpifx_gather_module !! !! ! I0 -> I1 !! send0 = mycomm%rank * 2 ! Arbitrary number to send - !! if (mycomm%master) then + !! if (mycomm%lead) then !! allocate(recv1(1 * mycomm%size)) !! recv1(:) = 0 !! else @@ -51,7 +51,7 @@ module mpifx_gather_module !! end if !! write(*, *) mycomm%rank, "Send0 buffer:", send0 !! call mpifx_gather(mycomm, send0, recv1) - !! if (mycomm%master) then + !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1(:) !! end if !! deallocate(recv1) @@ -59,7 +59,7 @@ module mpifx_gather_module !! ! I1 -> I1 !! allocate(send1(2)) !! send1(:) = [ mycomm%rank, mycomm%rank + 1 ] ! Arbitrary numbers - !! if (mycomm%master) then + !! if (mycomm%lead) then !! allocate(recv1(size(send1) * mycomm%size)) !! recv1(:) = 0 !! else @@ -67,19 +67,19 @@ module mpifx_gather_module !! end if !! write(*, *) mycomm%rank, "Send1 buffer:", send1(:) !! call mpifx_gather(mycomm, send1, recv1) - !! if (mycomm%master) then + !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 !! end if !! !! ! I1 -> I2 !! send1(:) = [ mycomm%rank, mycomm%rank + 1 ] - !! if (mycomm%master) then + !! if (mycomm%lead) then !! allocate(recv2(size(send1), mycomm%size)) !! recv2(:,:) = 0 !! end if !! write(*, *) mycomm%rank, "Send1 buffer:", send1(:) !! call mpifx_gather(mycomm, send1, recv2) - !! if (mycomm%master) then + !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv2 buffer:", recv2 !! end if !! @@ -112,7 +112,7 @@ contains !! \param mycomm MPI communicator. !! \param send Quantity to be sent for gathering. !! \param recv Received data on receive node (undefined on other nodes) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_gather_${SUFFIX}$(mycomm, send, recv, root, error) @@ -127,11 +127,11 @@ contains #:set SIZE = 'size(send)' #:set COUNT = ('len(send) * ' + SIZE if HASLENGTH else SIZE) - @:ASSERT(.not. mycomm%master .or. size(recv) == size(send) * mycomm%size) - @:ASSERT(.not. mycomm%master .or.& + @:ASSERT(.not. mycomm%lead .or. size(recv) == size(send) * mycomm%size) + @:ASSERT(.not. mycomm%lead .or.& & size(recv, dim=${RANK}$) == size(send, dim=${RANK}$) * mycomm%size) - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) call mpi_gather(send, ${COUNT}$, ${MPITYPE}$, recv, ${COUNT}$, ${MPITYPE}$, root0,& & mycomm%id, error0) call handle_errorflag(error0, "MPI_GATHER in mpifx_gather_${SUFFIX}$", error) @@ -150,7 +150,7 @@ contains !! \param mycomm MPI communicator. !! \param send Quantity to be sent for gathering. !! \param recv Received data on receive node (indefined on other nodes) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_gather_${SUFFIX}$(mycomm, send, recv, root, error) @@ -165,10 +165,10 @@ contains #:set SIZE = '1' if RANK == 0 else 'size(send)' #:set COUNT = ('len(send) * ' + SIZE if HASLENGTH else SIZE) - @:ASSERT(.not. mycomm%master .or. size(recv) == ${SIZE}$ * mycomm%size) - @:ASSERT(.not. mycomm%master .or. size(recv, dim=${RANK + 1}$) == mycomm%size) + @:ASSERT(.not. mycomm%lead .or. size(recv) == ${SIZE}$ * mycomm%size) + @:ASSERT(.not. mycomm%lead .or. size(recv, dim=${RANK + 1}$) == mycomm%size) - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) call mpi_gather(send, ${SIZE}$, ${MPITYPE}$, recv, ${SIZE}$, ${MPITYPE}$, root0, mycomm%id,& & error0) call handle_errorflag(error0, "MPI_GATHER in mpifx_gather_${SUFFIX}$", error) diff --git a/lib/mpifx_gatherv.fpp b/lib/mpifx_gatherv.fpp index 9cd8378..c1cb677 100644 --- a/lib/mpifx_gatherv.fpp +++ b/lib/mpifx_gatherv.fpp @@ -17,7 +17,7 @@ !! \param recvcounts Counts of received data from each process !! \param displs Entry i specifies where to place data from process rank i-1 !! (default: computed from recvcounts assuming order with rank) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_gatherv_${SUFFIX}$(mycomm, send, recv, recvcounts, displs, root, error) @@ -33,7 +33,7 @@ integer, allocatable :: displs0(:) logical, allocatable :: testBuffer(:) - @:inoptflags(root0, root, mycomm%masterrank) + @:inoptflags(root0, root, mycomm%leadrank) if (mycomm%rank == root0) then allocate(displs0(mycomm%size)) @@ -87,7 +87,7 @@ !! \param recvcounts Counts of received data from each process !! \param displs Entry i specifies where to place data from process rank i-1 !! (default: computed from recvcounts assuming order with rank) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_gatherv_${SUFFIX}$(mycomm, send, recv, recvcounts, displs, root, error) @@ -102,7 +102,7 @@ integer :: ii, root0, error0 integer, allocatable :: displs0(:) - @:inoptflags(root0, root, mycomm%masterrank) + @:inoptflags(root0, root, mycomm%leadrank) if (mycomm%rank == root0) then @:ASSERT(size(recv) == sum(recvcounts)) @@ -173,7 +173,7 @@ module mpifx_gatherv_module !! ! I1 -> I1 !! allocate(send1(mycomm%rank+1)) !! send1 = 1.0*mycomm%rank - !! if (mycomm%master) then + !! if (mycomm%lead) then !! ! recv1 size is 1+2+3+...+mycomm%size !! nrecv = mycomm%size*(mycomm%size+1)/2 !! allocate(recv1(nrecv)) @@ -188,7 +188,7 @@ module mpifx_gatherv_module !! !! write(*, *) mycomm%rank, "Send1 buffer:", send1(:) !! call mpifx_gatherv(mycomm, send1, recv1, recvcounts) - !! if (mycomm%master) then + !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 !! end if !! diff --git a/lib/mpifx_recv.fpp b/lib/mpifx_recv.fpp index fd91f23..d5ec093 100644 --- a/lib/mpifx_recv.fpp +++ b/lib/mpifx_recv.fpp @@ -33,11 +33,11 @@ module mpifx_recv_module !! !! call mpifx_init() !! call mycomm%init() - !! if (.not. mycomm%master) then + !! if (.not. mycomm%lead) then !! write(msg, "(A,I0,A)") "Hello from process ", mycomm%rank, "!" - !! call mpifx_send(mycomm, msg, mycomm%masterrank) + !! call mpifx_send(mycomm, msg, mycomm%leadrank) !! else - !! write(*, "(A)") "Master node:" + !! write(*, "(A)") "Lead node:" !! do source = 1, mycomm%size - 1 !! call mpifx_recv(mycomm, msg, source) !! write(*,"(A,A)") "Message received: ", trim(msg) diff --git a/lib/mpifx_reduce.fpp b/lib/mpifx_reduce.fpp index d2f3ff1..b14fdb3 100644 --- a/lib/mpifx_reduce.fpp +++ b/lib/mpifx_reduce.fpp @@ -109,7 +109,7 @@ contains !! \param orig Quantity to be reduced. !! \param reduced Contains result on exit. !! \param reduceop Reduction operator. - !! \param root Root process for the reduced (default: mycomm%masterrank) + !! \param root Root process for the reduced (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_reduce_${SUFFIX}$(mycomm, orig, reduced, reduceop, root, error) @@ -122,7 +122,7 @@ contains integer :: root0, error0 - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) #:set SIZE = '1' if RANK == 0 else 'size(orig)' #:set COUNT = SIZE @@ -144,7 +144,7 @@ contains !! \param mycomm MPI communicator. !! \param origred Quantity to be reduced on input, result on exit !! \param reduceop Reduction reduceop - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_reduceip_${SUFFIX}$(mycomm, origred, reduceop, root, error) @@ -157,7 +157,7 @@ contains integer :: root0, error0 ${TYPE}$ :: dummy - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) #:set SIZE = '1' if RANK == 0 else 'size(origred)' #:set COUNT = SIZE diff --git a/lib/mpifx_scatter.fpp b/lib/mpifx_scatter.fpp index 848fd04..de288b9 100644 --- a/lib/mpifx_scatter.fpp +++ b/lib/mpifx_scatter.fpp @@ -41,7 +41,7 @@ module mpifx_scatter_module !! call mycomm%init() !! !! ! I1 -> I0 - !! if (mycomm%master) then + !! if (mycomm%lead) then !! allocate(send1(mycomm%size)) !! send1(:) = [ (ii, ii = 1, size(send1)) ] !! write(*, *) mycomm%rank, "Send1 buffer:", send1 @@ -53,7 +53,7 @@ module mpifx_scatter_module !! write(*, *) mycomm%rank, "Recv0 buffer:", recv0 !! !! ! I1 -> I1 - !! if (mycomm%master) then + !! if (mycomm%lead) then !! deallocate(send1) !! allocate(send1(2 * mycomm%size)) !! send1(:) = [ (ii, ii = 1, size(send1)) ] @@ -65,7 +65,7 @@ module mpifx_scatter_module !! write(*, *) mycomm%rank, "Recv1 buffer:", recv1 !! !! ! I2 -> I1 - !! if (mycomm%master) then + !! if (mycomm%lead) then !! allocate(send2(2, mycomm%size)) !! send2(:,:) = reshape(send1, [ 2, mycomm%size ]) !! write(*, *) mycomm%rank, "Send2 buffer:", send2 @@ -101,7 +101,7 @@ contains !! \param mycomm MPI communicator. !! \param send Quantity to be sent for scattering. !! \param recv Received data on receive node (undefined on other nodes) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_scatter_${SUFFIX}$(mycomm, send, recv, root, error) @@ -116,11 +116,11 @@ contains #:set SIZE = 'size(recv)' #:set COUNT = ('len(recv) * ' + SIZE if HASLENGTH else SIZE) - @:ASSERT(.not. mycomm%master .or. size(send) == size(recv) * mycomm%size) - @:ASSERT(.not. mycomm%master& + @:ASSERT(.not. mycomm%lead .or. size(send) == size(recv) * mycomm%size) + @:ASSERT(.not. mycomm%lead& & .or. size(send, dim=${RANK}$) == size(recv, dim=${RANK}$) * mycomm%size) - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) call mpi_scatter(send, ${COUNT}$, ${MPITYPE}$, recv, ${COUNT}$, ${MPITYPE}$, root0,& & mycomm%id, error0) call handle_errorflag(error0, "MPI_SCATTER in mpifx_scatter_${SUFFIX}$", error) @@ -139,7 +139,7 @@ contains !! \param mycomm MPI communicator. !! \param send Quantity to be sent for scattering. !! \param recv Received data on receive node (indefined on other nodes) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_scatter_${SUFFIX}$(mycomm, send, recv, root, error) @@ -154,13 +154,13 @@ contains #:set SIZE = '1' if RANK == 1 else 'size(recv)' #:set COUNT = ('len(recv) * ' + SIZE if HASLENGTH else SIZE) - @:ASSERT(.not. mycomm%master .or. size(send) == ${SIZE}$ * mycomm%size) - @:ASSERT(.not. mycomm%master .or. size(send, dim=${RANK}$) == mycomm%size) + @:ASSERT(.not. mycomm%lead .or. size(send) == ${SIZE}$ * mycomm%size) + @:ASSERT(.not. mycomm%lead .or. size(send, dim=${RANK}$) == mycomm%size) #:if HASLENGTH - @:ASSERT(.not. mycomm%master .or. len(send) == len(recv)) + @:ASSERT(.not. mycomm%lead .or. len(send) == len(recv)) #:endif - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) call mpi_scatter(send, ${COUNT}$, ${MPITYPE}$, recv, ${COUNT}$, ${MPITYPE}$, root0,& & mycomm%id, error0) call handle_errorflag(error0, "MPI_SCATTER in mpifx_scatter_${SUFFIX}$", error) diff --git a/lib/mpifx_scatterv.fpp b/lib/mpifx_scatterv.fpp index ebe1a6e..aaa4944 100644 --- a/lib/mpifx_scatterv.fpp +++ b/lib/mpifx_scatterv.fpp @@ -43,7 +43,7 @@ module mpifx_scatterv_module !! ! I1 -> I1 !! allocate(recv1(mycomm%rank+1)) !! recv1 = 0 - !! if (mycomm%master) then + !! if (mycomm%lead) then !! ! send1 size is 1+2+3+...+mycomm%size !! nsend = mycomm%size*(mycomm%size+1)/2 !! allocate(send1(nsend)) @@ -58,7 +58,7 @@ module mpifx_scatterv_module !! allocate(send1(0)) !! end if !! - !! if (mycomm%master) then + !! if (mycomm%lead) then !! write(*, *) mycomm%rank, "Send1 buffer:", send1(:) !! end if !! call mpifx_scatterv(mycomm, send1, sendcounts, recv1) @@ -92,7 +92,7 @@ contains !! \param recv Received data on receive node (undefined on other nodes) !! \param displs Entry i specifies where to take data to send to rank i !! (default: computed from sendcounts assuming order with rank) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_scatterv_${SUFFIX}$(mycomm, send, sendcounts, recv, displs, root, error) @@ -110,11 +110,11 @@ contains #:set SIZE = 'size(recv)' #:set COUNT = ('len(recv) * ' + SIZE if HASLENGTH else SIZE) - @:ASSERT(.not. mycomm%master .or. size(send) == size(recv) * mycomm%size) - @:ASSERT(.not. mycomm%master& + @:ASSERT(.not. mycomm%lead .or. size(send) == size(recv) * mycomm%size) + @:ASSERT(.not. mycomm%lead& & .or. size(send, dim=${RANK}$) == size(recv, dim=${RANK}$) * mycomm%size) - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) if (mycomm%rank == root0) then if (present(displs)) then @:ASSERT(size(displs) == mycomm%size) @@ -150,7 +150,7 @@ contains !! \param recv Received data on receive node (indefined on other nodes) !! \param displs Entry i specifies where to take data to send to rank i !! (default: computed from sendcounts assuming order with rank) - !! \param root Root process for the result (default: mycomm%masterrank) + !! \param root Root process for the result (default: mycomm%leadrank) !! \param error Error code on exit. !! subroutine mpifx_scatterv_${SUFFIX}$(mycomm, send, sendcounts, recv, displs, root, error) @@ -168,13 +168,13 @@ contains #:set SIZE = '1' if RANK == 1 else 'size(recv)' #:set COUNT = ('len(recv) * ' + SIZE if HASLENGTH else SIZE) - @:ASSERT(.not. mycomm%master .or. size(send) == ${SIZE}$ * mycomm%size) - @:ASSERT(.not. mycomm%master .or. size(send, dim=${RANK}$) == mycomm%size) + @:ASSERT(.not. mycomm%lead .or. size(send) == ${SIZE}$ * mycomm%size) + @:ASSERT(.not. mycomm%lead .or. size(send, dim=${RANK}$) == mycomm%size) #:if HASLENGTH - @:ASSERT(.not. mycomm%master .or. len(send) == len(recv)) + @:ASSERT(.not. mycomm%lead .or. len(send) == len(recv)) #:endif - call getoptarg(mycomm%masterrank, root0, root) + call getoptarg(mycomm%leadrank, root0, root) if (mycomm%rank == root0) then if (present(displs)) then @:ASSERT(size(displs) == mycomm%size) diff --git a/lib/mpifx_send.fpp b/lib/mpifx_send.fpp index 32c8f46..fc775dd 100644 --- a/lib/mpifx_send.fpp +++ b/lib/mpifx_send.fpp @@ -33,11 +33,11 @@ module mpifx_send_module !! !! call mpifx_init() !! call mycomm%init() - !! if (.not. mycomm%master) then + !! if (.not. mycomm%lead) then !! write(msg, "(A,I0,A)") "Hello from process ", mycomm%rank, "!" - !! call mpifx_send(mycomm, msg, mycomm%masterrank) + !! call mpifx_send(mycomm, msg, mycomm%leadrank) !! else - !! write(*, "(A)") "Master node:" + !! write(*, "(A)") "Lead node:" !! do source = 1, mycomm%size - 1 !! call mpifx_recv(mycomm, msg, source) !! write(*,"(A,A)") "Message received: ", trim(msg) diff --git a/test/test_bcast.f90 b/test/test_bcast.f90 index b83a894..d4e5ba0 100644 --- a/test/test_bcast.f90 +++ b/test/test_bcast.f90 @@ -17,7 +17,7 @@ program test_bcast call mycomm%init() buffer(:) = 0 print "(A,I2.2,A,3I5)", "CHK01:", mycomm%rank, ":", buffer - if (mycomm%master) then + if (mycomm%lead) then buffer(:) = [ 1, 2, 3 ] end if print "(A,I2.2,A,3I5)", "CHK02:", mycomm%rank, ":", buffer @@ -28,7 +28,7 @@ program test_bcast ! Logical vector lbuffer(:) = .false. print "(A,I2.2,A,3L5)", "CHK04:", mycomm%rank, ":", lbuffer - if (mycomm%master) then + if (mycomm%lead) then lbuffer(:) = [ .true., .false., .true. ] end if print "(A,I2.2,A,3L5)", "CHK05:", mycomm%rank, ":", lbuffer @@ -39,7 +39,7 @@ program test_bcast ! Real rank 2 array rbuffer(:,:) = 0.0_dp print "(A,I2.2,A,4F10.6)", "CHK07:", mycomm%rank, ":", rbuffer - if (mycomm%master) then + if (mycomm%lead) then rbuffer(:,:) = reshape([ real(dp) :: 1, 2, 3, 4 ], [ 2, 2 ]) end if print "(A,I2.2,A,4F10.6)", "CHK08:", mycomm%rank, ":", rbuffer @@ -50,7 +50,7 @@ program test_bcast ! Complex scalar cbuffer = cmplx(0, 0, sp) print "(A,I2.2,A,2F10.6)", "CHK10:", mycomm%rank, ":", cbuffer - if (mycomm%master) then + if (mycomm%lead) then cbuffer = cmplx(-1, 1, sp) end if print "(A,I2.2,A,2F10.6)", "CHK11:", mycomm%rank, ":", cbuffer @@ -60,7 +60,7 @@ program test_bcast ! Character text = " " print "(A,I2.2,A,A6)", "CHK13:", mycomm%rank, ":", text - if (mycomm%master) then + if (mycomm%lead) then text = "hello" end if print "(A,I2.2,A,A6)", "CHK14:", mycomm%rank, ":", text diff --git a/test/test_gather.f90 b/test/test_gather.f90 index bbd0630..4badc84 100644 --- a/test/test_gather.f90 +++ b/test/test_gather.f90 @@ -14,7 +14,7 @@ program test_gather ! I0 -> I1 send0 = mycomm%rank * 2 ! Arbitrary number to send - if (mycomm%master) then + if (mycomm%lead) then allocate(recv1(1 * mycomm%size)) recv1(:) = 0 else @@ -23,7 +23,7 @@ program test_gather write(*, label // ",A,1X,I0)") 1, mycomm%rank, & & "Send0 buffer:", send0 call mpifx_gather(mycomm, send0, recv1) - if (mycomm%master) then + if (mycomm%lead) then write(formstr, "(A,I0,A)") "A,", size(recv1), "(1X,I0))" write(*, label // formstr) 2, mycomm%rank, & & "Recv1 buffer:", recv1(:) @@ -32,7 +32,7 @@ program test_gather ! I1 -> I1 allocate(send1(2)) - if (mycomm%master) then + if (mycomm%lead) then allocate(recv1(size(send1) * mycomm%size)) recv1(:) = 0 else @@ -43,14 +43,14 @@ program test_gather write(*, label // formstr) 3, mycomm%rank, & & "Send1 buffer:", send1(:) call mpifx_gather(mycomm, send1, recv1) - if (mycomm%master) then + if (mycomm%lead) then write(formstr, "(A,I0,A)") "A,", size(recv1), "(1X,I0))" write(*, label // formstr) 4, mycomm%rank, & & "Recv1 buffer:", recv1 end if ! I1 -> I2 - if (mycomm%master) then + if (mycomm%lead) then allocate(recv2(size(send1), mycomm%size)) recv2(:,:) = 0 else @@ -61,7 +61,7 @@ program test_gather write(*, label // formstr) 5, mycomm%rank, & & "Send1 buffer:", send1(:) call mpifx_gather(mycomm, send1, recv2) - if (mycomm%master) then + if (mycomm%lead) then write(formstr, "(A,I0,A)") "A,", size(recv2), "(1X,I0))" write(*, label // formstr) 6, mycomm%rank, & & "Recv2 buffer:", recv2 diff --git a/test/test_gatherv.f90 b/test/test_gatherv.f90 index 7c7318a..e681496 100644 --- a/test/test_gatherv.f90 +++ b/test/test_gatherv.f90 @@ -17,12 +17,12 @@ program test_gatherv call mycomm%init() ! R1 -> R1 - if (mycomm%master) then + if (mycomm%lead) then write(*, *) 'Test gather rank=1 -> rank=1' end if allocate(send1(mycomm%rank+1)) send1 = real(mycomm%rank+1, sp) - if (mycomm%master) then + if (mycomm%lead) then ! recv1 size is 1+2+3+...+mycomm%size nrecv = mycomm%size*(mycomm%size+1)/2 allocate(recv1(nrecv)) @@ -34,20 +34,20 @@ program test_gatherv allocate(recv1(0)) end if call mpifx_gatherv(mycomm, send1, recv1, recvcounts) - if (mycomm%master) then + if (mycomm%lead) then write(*, *) "Recv1 buffer:", recv1 deallocate(recvcounts) end if deallocate(recv1) ! R2 -> R2 - if (mycomm%master) then + if (mycomm%lead) then write(*, *) write(*, *) 'Test gather rank=2 -> rank=2' end if allocate(send2(10, mycomm%rank+1)) send2 = real(mycomm%rank + 1, sp) - if (mycomm%master) then + if (mycomm%lead) then ! recv1 size is 1+2+3+...+mycomm%size nrecv = mycomm%size*(mycomm%size+1)/2 allocate(recv2(10, nrecv)) @@ -60,19 +60,19 @@ program test_gatherv allocate(recv2(0,0)) end if call mpifx_gatherv(mycomm, send2, recv2, recvcounts) - if (mycomm%master) then + if (mycomm%lead) then write(*, *) "Recv2 buffer:", recv2(:,:) deallocate(recvcounts) end if deallocate(recv2) ! R0 -> R1 with specified receive pattern - if (mycomm%master) then + if (mycomm%lead) then write(*, *) write(*, *) 'Test gather scalar -> rank=1' end if send0 = real(mycomm%rank + 1, sp) - if (mycomm%master) then + if (mycomm%lead) then nrecv = mycomm%size allocate(recv1(nrecv)) allocate(recvcounts(mycomm%size)) @@ -86,7 +86,7 @@ program test_gatherv allocate(recv1(0)) end if call mpifx_gatherv(mycomm, send0, recv1, recvcounts, displs) - if (mycomm%master) then + if (mycomm%lead) then write(*, *) "Recv1 buffer:", recv1 deallocate(recvcounts) deallocate(displs) @@ -94,12 +94,12 @@ program test_gatherv deallocate(recv1) ! R0 -> R1 with specified receive pattern including gaps - if (mycomm%master) then + if (mycomm%lead) then write(*, *) write(*, *) 'Test gather scalar -> rank=1' end if send0 = real(mycomm%rank + 1, sp) - if (mycomm%master) then + if (mycomm%lead) then nrecv = mycomm%size allocate(recv1(2*nrecv)) allocate(recvcounts(mycomm%size)) @@ -115,7 +115,7 @@ program test_gatherv allocate(recv1(0)) end if call mpifx_gatherv(mycomm, send0, recv1, recvcounts, displs) - if (mycomm%master) then + if (mycomm%lead) then write(*, *) "Recv1 buffer:", recv1 deallocate(recvcounts) deallocate(displs) diff --git a/test/test_scatter.f90 b/test/test_scatter.f90 index 8bcf63f..7bbbad3 100644 --- a/test/test_scatter.f90 +++ b/test/test_scatter.f90 @@ -14,7 +14,7 @@ program test_scatter call mycomm%init() ! I1 -> I0 - if (mycomm%master) then + if (mycomm%lead) then allocate(send1(mycomm%size)) send1(:) = [ (ii, ii = 1, size(send1)) ] write(formstr, "(A,I0,A)") "A,", size(send1), "(1X,I0))" @@ -30,7 +30,7 @@ program test_scatter & "Recv0 buffer:", recv0 ! I1 -> I1 - if (mycomm%master) then + if (mycomm%lead) then deallocate(send1) allocate(send1(2 * mycomm%size)) send1(:) = [ (ii, ii = 1, size(send1)) ] @@ -46,7 +46,7 @@ program test_scatter & "Recv1 buffer:", recv1 ! I2 -> I1 - if (mycomm%master) then + if (mycomm%lead) then allocate(send2(2, mycomm%size)) send2(:,:) = reshape(send1, [ 2, mycomm%size ]) write(formstr, "(A,I0,A)") "A,", size(send2), "(1X,I0))" diff --git a/test/test_scatterv.f90 b/test/test_scatterv.f90 index 53b08c8..6de8d51 100644 --- a/test/test_scatterv.f90 +++ b/test/test_scatterv.f90 @@ -14,7 +14,7 @@ program test_scatterv call mycomm%init() ! I1 -> I0 - if (mycomm%master) then + if (mycomm%lead) then allocate(send1(mycomm%size)) allocate(sendcount(mycomm%size)) send1(:) = [ (ii, ii = 1, size(send1)) ] @@ -31,7 +31,7 @@ program test_scatterv write(*, label // formstr) 2, mycomm%rank, "Recv0 buffer:", recv0 ! I1 -> I1 - if (mycomm%master) then + if (mycomm%lead) then deallocate(send1) allocate(send1(2 * mycomm%size)) sendcount(:) = 2 @@ -46,7 +46,7 @@ program test_scatterv write(*, label // formstr) 4, mycomm%rank, "Recv1 buffer:", recv1 ! I2 -> I1 - if (mycomm%master) then + if (mycomm%lead) then allocate(send2(2, mycomm%size)) sendcount(:) = 2 send2(:,:) = reshape(send1, [ 2, mycomm%size ]) @@ -63,7 +63,7 @@ program test_scatterv & "Recv1 buffer:", recv1 ! I1 -> I1 - if (mycomm%master) then + if (mycomm%lead) then deallocate(send1) allocate(send1(2 * mycomm%size)) send1(:) = [ (ii, ii = 1, size(send1)) ] diff --git a/test/test_send_recv.f90 b/test/test_send_recv.f90 index d86711b..ae228a1 100644 --- a/test/test_send_recv.f90 +++ b/test/test_send_recv.f90 @@ -8,11 +8,11 @@ program test_send_recv call mpifx_init() call mycomm%init() - if (.not. mycomm%master) then + if (.not. mycomm%lead) then write(msg, "(A,I0,A)") "Hello from process ", mycomm%rank, "!" - call mpifx_send(mycomm, msg, mycomm%masterrank) + call mpifx_send(mycomm, msg, mycomm%leadrank) else - write(*, "(A)") "Master node:" + write(*, "(A)") "Lead node:" do source = 1, mycomm%size - 1 call mpifx_recv(mycomm, msg, source) write(*,"(A,A)") "Message received: ", trim(msg) From fe60bcf9b31987190bdb1b38138c151440ec6946 Mon Sep 17 00:00:00 2001 From: Ben Hourahine Date: Mon, 15 Jun 2020 22:27:01 +0100 Subject: [PATCH 2/2] Comments from review --- external/fypp/README.rst | 2 +- lib/mpifx_comm.fpp | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/external/fypp/README.rst b/external/fypp/README.rst index 44bfd28..3d122fa 100644 --- a/external/fypp/README.rst +++ b/external/fypp/README.rst @@ -199,7 +199,7 @@ repository:: git clone https://github.com/aradi/fypp.git -and check out the default main branch. +and check out the default branch. The command line tool is a single stand-alone script. You can run it directly from the source folder :: diff --git a/lib/mpifx_comm.fpp b/lib/mpifx_comm.fpp index eb3f5a1..fa99e76 100644 --- a/lib/mpifx_comm.fpp +++ b/lib/mpifx_comm.fpp @@ -12,8 +12,8 @@ module mpifx_comm_module integer :: id !< Communicator id. integer :: size !< Nr. of processes (size). integer :: rank !< Rank of the current process. - integer :: leadrank !< Index of the lead node. - logical :: lead !< True if current process is the lead (rank == 0). + integer :: leadrank !< Index of the lead node. + logical :: lead !< True if current process is the lead (rank == 0). contains !> Initializes the MPI environment. procedure :: init => mpifx_comm_init