Skip to content

Commit c59215e

Browse files
scivisionscivision
committed
benchmarks: update api
1 parent 1e3cb8e commit c59215e

File tree

5 files changed

+55
-56
lines changed

5 files changed

+55
-56
lines changed

‎benchmark/test/slab_mpi_read.f90‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,9 @@ program read_slab_mpi
44
!! https://support.hdfgroup.org/ftp/HDF5/examples/parallel/hyperslab_by_row.f90
55

66
use, intrinsic :: iso_fortran_env, only : int32, int64, real64, real32, stderr=>error_unit
7-
use mpi, only : mpi_comm_size, mpi_comm_rank, mpi_integer
7+
use mpi, only : mpi_comm_size, mpi_comm_rank, mpi_integer, MPI_COMM_WORLD
88

9-
use h5fortran, only : mpi_h5comm, hdf5_file, HSIZE_T
9+
use h5fortran, only : hdf5_file, HSIZE_T
1010

1111
use cli, only : get_cli
1212
use perf, only : print_timing, sysclock2ms
@@ -41,8 +41,8 @@ program read_slab_mpi
4141
call mpi_init(ierr)
4242
if(ierr/=0) error stop "mpi_init"
4343

44-
call mpi_comm_size(mpi_h5comm, Nmpi, ierr)
45-
call mpi_comm_rank(mpi_h5comm, mpi_id, ierr)
44+
call mpi_comm_size(MPI_COMM_WORLD, Nmpi, ierr)
45+
call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
4646

4747
do i = 1, command_argument_count()
4848
call get_command_argument(i, argv, status=ierr)
@@ -78,15 +78,15 @@ program read_slab_mpi
7878
print '(a,i0,a,i0,1x,i0,1x,i0)', "MPI-root: ", Nmpi, " total MPI processes. shape: ", lx1, lx2, lx3
7979
endif
8080

81-
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
82-
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
83-
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
81+
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
82+
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
83+
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
8484
! call mpi_wait(mpi_req, MPI_STATUS_IGNORE, ierr)
85-
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
85+
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8686
if(ierr/=0) error stop "failed to broadcast lx1"
87-
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
87+
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8888
if(ierr/=0) error stop "failed to broadcast lx2"
89-
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
89+
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
9090
if(ierr/=0) error stop "failed to broadcast lx3"
9191
if(lx3 < 1 .or. lx2 < 1 .or. lx1 < 1) then
9292
write(stderr,"(A,i0,A,i0,1x,i0,1x,i0)") "ERROR: MPI ID: ", mpi_id, " failed to receive lx1, lx2, lx3: ", lx1, lx2, lx3

‎benchmark/test/slab_mpi_serial_read.f90‎

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,9 @@ program read_slab_mpi_root
44
!! https://support.hdfgroup.org/ftp/HDF5/examples/parallel/hyperslab_by_row.f90
55

66
use, intrinsic :: iso_fortran_env, only : int32, int64, real64, stderr=>error_unit
7-
use mpi, only : mpi_comm_rank, mpi_comm_size, mpi_integer, mpi_real, mpi_status_ignore
7+
use mpi, only : mpi_comm_rank, mpi_comm_size, mpi_integer, mpi_real, MPI_STATUS_IGNORE, MPI_COMM_WORLD
88

9-
use h5fortran, only : mpi_h5comm, hdf5_file, mpi_tags, HSIZE_T
9+
use h5fortran, only : hdf5_file, HSIZE_T
1010

1111
use cli, only : get_cli
1212
use perf, only : print_timing, sysclock2ms
@@ -15,10 +15,9 @@ program read_slab_mpi_root
1515

1616
external :: mpi_bcast, mpi_init, mpi_finalize, mpi_send, mpi_recv
1717

18-
type(mpi_tags) :: mt
19-
2018
type(hdf5_file) :: h5
2119

20+
integer, parameter :: tA3 = 100
2221
real, allocatable :: A3(:,:,:), t3(:,:,:)
2322
character(1000) :: argv
2423

@@ -41,8 +40,8 @@ program read_slab_mpi_root
4140
call mpi_init(ierr)
4241
if(ierr/=0) error stop "mpi_init"
4342

44-
call mpi_comm_size(mpi_h5comm, Nmpi, ierr)
45-
call mpi_comm_rank(mpi_h5comm, mpi_id, ierr)
43+
call mpi_comm_size(MPI_COMM_WORLD, Nmpi, ierr)
44+
call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
4645

4746
do i = 1, command_argument_count()
4847
call get_command_argument(i, argv, status=ierr)
@@ -76,15 +75,15 @@ program read_slab_mpi_root
7675
print '(a,i0,a,i0,1x,i0,1x,i0)', "MPI-root: ", Nmpi, " total MPI processes. shape: ", lx1, lx2, lx3
7776
endif
7877

79-
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
80-
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
81-
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
78+
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
79+
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
80+
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
8281
! call mpi_wait(mpi_req, MPI_STATUS_IGNORE, ierr)
83-
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
82+
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8483
if(ierr/=0) error stop "failed to broadcast lx1"
85-
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
84+
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8685
if(ierr/=0) error stop "failed to broadcast lx2"
87-
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
86+
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8887
if(ierr/=0) error stop "failed to broadcast lx3"
8988
if(lx3 < 0 .or. lx2 < 1 .or. lx1 < 1) then
9089
write(stderr,"(A,i0,A,i0,1x,i0,1x,i0)") "ERROR: MPI ID: ", mpi_id, " failed to receive lx1, lx2, lx3: ", lx1, lx2, lx3
@@ -125,12 +124,12 @@ program read_slab_mpi_root
125124
do i = 1, Nmpi-1
126125
i0 = mpi_id * dx2 + 1
127126
i1 = (mpi_id + 1) * dx2
128-
call mpi_send(A3(:, i0:i1, :), lx1*dx2*lx3, MPI_REAL, i, mt%a3, mpi_h5comm, ierr)
127+
call mpi_send(A3(:, i0:i1, :), lx1*dx2*lx3, MPI_REAL, i, tA3, MPI_COMM_WORLD, ierr)
129128
if(ierr/=0) error stop "root => worker: mpi_send 3D"
130129
end do
131130
else
132131
!! workers receive data from root
133-
call mpi_recv(A3, lx1*dx2*lx3, MPI_REAL, mpi_root_id, mt%a3, mpi_h5comm, MPI_STATUS_IGNORE, ierr)
132+
call mpi_recv(A3, lx1*dx2*lx3, MPI_REAL, mpi_root_id, tA3, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
134133
if(ierr/=0) error stop "root => worker: mpi_recv 3D"
135134
endif
136135

‎benchmark/test/slab_mpi_serial_write.f90‎

Lines changed: 14 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,9 @@ program write_slab_mpi_root
66
use, intrinsic :: ieee_arithmetic, only : ieee_is_finite
77
use, intrinsic :: iso_fortran_env, only : int64, real32, real64, stderr=>error_unit
88

9-
use mpi, only : mpi_comm_rank, mpi_comm_size, mpi_integer, mpi_real, mpi_status_ignore
9+
use mpi, only : mpi_comm_rank, mpi_comm_size, mpi_integer, mpi_real, MPI_STATUS_IGNORE, MPI_COMM_WORLD
1010

11-
use h5fortran, only : mpi_h5comm, hdf5_file, mpi_tags
11+
use h5fortran, only : hdf5_file
1212

1313
use cli, only : get_cli, get_simsize
1414
use perf, only : print_timing, sysclock2ms
@@ -18,10 +18,9 @@ program write_slab_mpi_root
1818

1919
external :: mpi_bcast, mpi_init, mpi_finalize, mpi_send, mpi_recv
2020

21-
type(mpi_tags) :: mt
22-
2321
type(hdf5_file) :: h5
2422

23+
integer, parameter :: ta3 = 100
2524
real(real32), allocatable :: S3(:,:,:), ts3(:,:,:), V3(:), dv3(:)
2625

2726
!> default parameters
@@ -44,8 +43,8 @@ program write_slab_mpi_root
4443
call mpi_init(ierr)
4544
if(ierr/=0) error stop "mpi_init"
4645

47-
call mpi_comm_size(mpi_h5comm, Nmpi, ierr)
48-
call mpi_comm_rank(mpi_h5comm, mpi_id, ierr)
46+
call mpi_comm_size(MPI_COMM_WORLD, Nmpi, ierr)
47+
call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
4948

5049
do i = 1, command_argument_count()
5150
call get_command_argument(i, argv, status=ierr)
@@ -77,15 +76,15 @@ program write_slab_mpi_root
7776
print '(a,i0,a,i0,1x,i0,1x,i0)', "MPI-root write. ", Nmpi, " total MPI processes. shape: ", lx1, lx2, lx3
7877
endif
7978

80-
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
81-
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
82-
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
79+
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
80+
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
81+
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
8382
! call mpi_wait(mpi_req, MPI_STATUS_IGNORE, ierr)
84-
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
83+
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8584
if(ierr/=0) error stop "failed to broadcast lx1"
86-
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
85+
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8786
if(ierr/=0) error stop "failed to broadcast lx2"
88-
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
87+
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
8988
if(ierr/=0) error stop "failed to broadcast lx3"
9089
if(lx2 < 1 .or. lx1 < 1) then
9190
write(stderr,"(A,i0,A,i0,1x,i0,1x,i0)") "ERROR: MPI ID: ", mpi_id, " failed to receive lx1, lx2, lx3: ", lx1, lx2, lx3
@@ -107,7 +106,7 @@ program write_slab_mpi_root
107106
tic = 0
108107
if (mpi_id == mpi_root_id) call system_clock(count=tic)
109108

110-
call generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, mt%a3, mpi_h5comm, noise, gensig, S3)
109+
call generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, ta3, noise, gensig, S3)
111110

112111
!> sanity check generated data on the worker
113112

@@ -145,12 +144,12 @@ program write_slab_mpi_root
145144
do i = 1, Nmpi-1
146145
i0 = i*dx2 + 1
147146
i1 = (i + 1)*dx2
148-
call mpi_recv(S3(:, i0:i1, :), lx1*dx2*lx3, MPI_REAL, i, mt%a3, mpi_h5comm, MPI_STATUS_IGNORE, ierr)
147+
call mpi_recv(S3(:, i0:i1, :), lx1*dx2*lx3, MPI_REAL, i, ta3, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
149148
if(ierr/=0) error stop "worker => root: mpi_recv 3D"
150149
end do
151150
else
152151
!! workers send data to root
153-
call mpi_send(S3, lx1*dx2*lx3, MPI_REAL, mpi_root_id, mt%a3, mpi_h5comm, ierr)
152+
call mpi_send(S3, lx1*dx2*lx3, MPI_REAL, mpi_root_id, ta3, MPI_COMM_WORLD, ierr)
154153
if(ierr/=0) error stop "worker => root: mpi_send 3D"
155154
endif
156155

‎benchmark/test/slab_mpi_write.f90‎

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,9 @@ program write_slab_mpi
66
use, intrinsic :: ieee_arithmetic, only : ieee_is_finite
77
use, intrinsic :: iso_fortran_env, only : int64, real64, real32, stderr=>error_unit
88

9-
use mpi, only : mpi_comm_size, mpi_comm_rank, mpi_integer
9+
use mpi, only : mpi_comm_size, mpi_comm_rank, mpi_integer, MPI_COMM_WORLD
1010

11-
use h5fortran, only : mpi_h5comm, hdf5_file, mpi_tags, HSIZE_T
11+
use h5fortran, only : hdf5_file
1212

1313
use cli, only : get_cli, get_simsize
1414
use perf, only : print_timing, sysclock2ms
@@ -19,7 +19,8 @@ program write_slab_mpi
1919
external :: mpi_bcast, mpi_init, mpi_finalize
2020

2121
type(hdf5_file) :: h5
22-
type(mpi_tags) :: mt
22+
23+
integer, parameter :: ta3 = 100
2324

2425
real(real32), allocatable :: S3(:,:,:), ts3(:,:,:), V3(:), dv3(:)
2526

@@ -47,9 +48,9 @@ program write_slab_mpi
4748
call mpi_init(ierr)
4849
if(ierr/=0) error stop "mpi_init"
4950

50-
call mpi_comm_size(mpi_h5comm, Nmpi, ierr)
51+
call mpi_comm_size(MPI_COMM_WORLD, Nmpi, ierr)
5152
if(ierr/=0) error stop "mpi_comm_size"
52-
call mpi_comm_rank(mpi_h5comm, mpi_id, ierr)
53+
call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
5354
if(ierr/=0) error stop "mpi_comm_rank"
5455

5556
do i = 1, command_argument_count()
@@ -83,15 +84,15 @@ program write_slab_mpi
8384
print '(a,i0,a,i0,1x,i0,1x,i0)', "MPI-HDF5 parallel write. ", Nmpi, " total MPI processes. shape: ", lx1, lx2, lx3
8485
endif
8586

86-
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
87-
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
88-
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, mpi_req, ierr)
87+
! call mpi_ibcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
88+
! call mpi_ibcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
89+
! call mpi_ibcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, mpi_req, ierr)
8990
! call mpi_wait(mpi_req, MPI_STATUS_IGNORE, ierr)
90-
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
91+
call mpi_bcast(lx1, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
9192
if(ierr/=0) error stop "failed to broadcast lx1"
92-
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
93+
call mpi_bcast(lx2, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
9394
if(ierr/=0) error stop "failed to broadcast lx2"
94-
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, mpi_h5comm, ierr)
95+
call mpi_bcast(lx3, 1, MPI_INTEGER, mpi_root_id, MPI_COMM_WORLD, ierr)
9596
if(ierr/=0) error stop "failed to broadcast lx3"
9697
if(lx3 < 1 .or. lx2 < 1 .or. lx1 < 1) then
9798
write(stderr,"(A,i0,A,i0,1x,i0,1x,i0)") "ERROR: MPI ID: ", mpi_id, " failed to receive lx1, lx2, lx3: ", lx1, lx2, lx3
@@ -111,7 +112,7 @@ program write_slab_mpi
111112
tic = 0
112113
if (mpi_id == mpi_root_id) call system_clock(count=tic)
113114

114-
call generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, mt%A3, mpi_h5comm, noise, gensig, S3)
115+
call generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, tA3, noise, gensig, S3)
115116

116117
if (mpi_id == mpi_root_id) then
117118
call system_clock(count=toc)

‎benchmark/test/utils.f90‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ module test_utils
33
use, intrinsic :: ieee_arithmetic, only : ieee_value, ieee_quiet_nan, ieee_is_finite
44
use, intrinsic :: iso_fortran_env, only : real32
55

6-
use mpi, only : MPI_STATUS_IGNORE, MPI_REAL
6+
use mpi, only : MPI_STATUS_IGNORE, MPI_REAL, MPI_COMM_WORLD
77

88
use kernel, only : phantom
99

@@ -16,9 +16,9 @@ module test_utils
1616

1717
contains
1818

19-
subroutine generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, tagA3, mpi_h5comm, noise, gensig, A3)
19+
subroutine generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, tagA3, noise, gensig, A3)
2020

21-
integer, intent(in) :: Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, tagA3, mpi_h5comm
21+
integer, intent(in) :: Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, tagA3
2222
real(real32), intent(in) :: noise, gensig
2323
real(real32), intent(inout), allocatable :: A3(:,:,:)
2424

@@ -52,14 +52,14 @@ subroutine generate_and_send(Nmpi, mpi_id, mpi_root_id, dx2, lx1, lx2, lx3, tagA
5252
i0 = i*dx2 + 1
5353
i1 = (i + 1)*dx2
5454
! print '(a,i0,1x,i0)', "TRACE: generate istart, iend: ", i0, i1
55-
call mpi_send(t3(:, i0:i1, :), lx1*dx2*lx3, MPI_REAL, i, tagA3, mpi_h5comm, ierr)
55+
call mpi_send(t3(:, i0:i1, :), lx1*dx2*lx3, MPI_REAL, i, tagA3, MPI_COMM_WORLD, ierr)
5656
if (ierr /= 0) error stop "generate: root => worker: mpi_send 3D"
5757
end do
5858

5959
!> root's subarray
6060
A3(:, 1:dx2, :) = t3(:, 1:dx2, :)
6161
else
62-
call mpi_recv(A3, lx1*dx2*lx3, MPI_REAL, mpi_root_id, tagA3, mpi_h5comm, MPI_STATUS_IGNORE, ierr)
62+
call mpi_recv(A3, lx1*dx2*lx3, MPI_REAL, mpi_root_id, tagA3, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
6363
if (ierr /= 0) error stop "generate: root => worker: mpi_recv 3D"
6464
endif
6565

0 commit comments

Comments
 (0)