-
Notifications
You must be signed in to change notification settings - Fork 5
/
io_profiling_m.f90
213 lines (186 loc) · 8.98 KB
/
io_profiling_m.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
!
! Copyright (C) 2013, Northwestern University
! See COPYRIGHT notice in top-level directory.
!
module io_profiling_m
! module for Read-Write Restart files
use mpi
implicit none
character*256 :: dir_path ! directory name for output files
integer file_info, info_used
integer read_num ! number of read calls
integer write_num ! number of write calls
double precision read_amount ! total read amount
double precision write_amount ! total write amount
double precision io_amount ! total I/O amount
double precision openT, writeT, readT, closeT
! time for open, write, read, and close
contains
! ----------------------------------------------------------------
! print the MPI info objects to stdout
! ----------------------------------------------------------------
subroutine print_io_hints(info)
implicit none
integer, intent(in) :: info
! local variables
character*(MPI_MAX_INFO_VAL) key, value
integer i, nkeys, valuelen, err
logical flag
1001 FORMAT(' ',A32,' = ',A)
call MPI_Info_get_nkeys(info, nkeys, err)
print *, '---- MPI file info used ----'
do i=0, nkeys-1
key(:) = ' '
call MPI_Info_get_nthkey(info, i, key, err)
call MPI_Info_get(info, key, MPI_MAX_INFO_VAL, value, flag, err)
call MPI_Info_get_valuelen(info, key, valuelen, flag, err)
value(valuelen+1:) = ' '
if (key(len_trim(key):len_trim(key)) .EQ. char(0)) &
key(len_trim(key):) = ' '
print 1001, trim(key), trim(value)
enddo
print *
end subroutine print_io_hints
! ----------------------------------------------------------------
! get the file striping information from the MPI info objects
! ----------------------------------------------------------------
subroutine get_file_striping(info, striping_factor, striping_unit)
implicit none
integer, intent(in) :: info
integer, intent(out) :: striping_factor
integer, intent(out) :: striping_unit
! local variables
character*(MPI_MAX_INFO_VAL) key, value
integer i, nkeys, valuelen, err
logical flag
call MPI_Info_get_nkeys(info, nkeys, err)
do i=0, nkeys-1
key(:) = ' '
call MPI_Info_get_nthkey(info, i, key, err)
call MPI_Info_get(info, key, MPI_MAX_INFO_VAL, value, flag, err)
call MPI_Info_get_valuelen(info, key, valuelen, flag, err)
value(valuelen+1:) = ' '
if (key(len_trim(key):len_trim(key)) .EQ. char(0)) &
key(len_trim(key):) = ' '
if (trim(key) .EQ. 'striping_factor') &
read(value, '(i10)') striping_factor
if (trim(key) .EQ. 'striping_unit') &
read(value, '(i10)') striping_unit
enddo
end subroutine get_file_striping
!----< set_io_hints() >-------------------------------------------
subroutine set_io_hints(flag)
implicit none
integer, intent(in) :: flag
! local variables
integer err
! free up info and file type
if (flag .EQ. -1) then
if (file_info .NE. MPI_INFO_NULL) then
call MPI_Info_free(file_info, err)
file_info = MPI_INFO_NULL
endif
return
endif
read_amount = 0.0
write_amount = 0.0
io_amount = 0.0
read_num = 0
write_num = 0
openT = 0.0
writeT = 0.0
readT = 0.0
closeT = 0.0
info_used = MPI_INFO_NULL
! set MPI I/O hints for performance enhancement
call MPI_Info_create(file_info, err)
! set PnetCDF hints
call MPI_Info_set(file_info, "nc_var_align_size", "1", err);
call MPI_Info_set(file_info, "nc_in_place_swap", "enable", err);
end subroutine set_io_hints
!----< print_io_performance() >-----------------------------------
subroutine print_io_performance(io_time)
use topology_m, only : gcomm, myid, npes
use param_m, only : nx_g, ny_g, nz_g
use runtime_m, only : method, restart
implicit none
double precision, intent(inout) :: io_time
! local variables
double precision d_tmp, read_bandwidth, write_bandwidth, io_bandwidth
integer striping_factor, striping_unit, err
call MPI_Reduce(openT, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
openT = d_tmp
call MPI_Reduce(writeT, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
writeT = d_tmp
call MPI_Reduce(readT, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
readT = d_tmp
call MPI_Reduce(closeT, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
closeT = d_tmp
call MPI_Reduce(io_time, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
io_time = d_tmp
call MPI_Reduce(read_amount, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, gcomm, err)
read_amount = d_tmp
call MPI_Reduce(write_amount, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, gcomm, err)
write_amount = d_tmp
io_amount = read_amount + write_amount
if (myid == 0) then
io_bandwidth = 0.0
read_bandwidth = 0.0
write_bandwidth = 0.0
if (io_time > 0) io_bandwidth = io_amount / io_time
if (readT > 0) read_bandwidth = read_amount / readT
if (writeT > 0) write_bandwidth = write_amount / writeT
io_bandwidth = io_bandwidth / 1048576.0
io_amount = io_amount / 1073741824.0
read_bandwidth = read_bandwidth / 1048576.0
read_amount = read_amount / 1073741824.0
write_bandwidth = write_bandwidth / 1048576.0
write_amount = write_amount / 1073741824.0
striping_factor = 0
striping_unit = 0
if (info_used .NE. MPI_INFO_NULL) then
call print_io_hints(info_used)
call get_file_striping(info_used, striping_factor, striping_unit)
endif
2000 FORMAT(A)
2001 FORMAT(A, A)
2002 FORMAT(A ,I7)
2003 FORMAT(A ,I7, A)
2004 FORMAT(A ,F10.2, A)
2005 FORMAT(A, i7,' x',i7,' x',i7)
write(6,*) '++++ I/O is done through PnetCDF ++++'
if (method .EQ. 0) then
write(6,*) 'I/O method : blocking APIs'
else
write(6,*) 'I/O method : nonblocking APIs'
endif
if (restart) then
write(6,*) 'Run with restart : True'
else
write(6,*) 'Run with restart : False'
endif
write(6, 2002) ' No. MPI processes : ', npes
write(6, 2005) ' Global array size : ', nx_g, ny_g, nz_g
write(6, 2001) ' output file path : ',trim(dir_path)
write(6, 2002) ' file striping count : ',striping_factor
write(6, 2003) ' file striping size : ',striping_unit, ' bytes'
write(6, 2000) ' -----------------------------------------------'
write(6, 2004) ' Time for open : ',openT, ' sec'
write(6, 2004) ' Time for read : ',readT, ' sec'
write(6, 2004) ' Time for write : ',writeT, ' sec'
write(6, 2004) ' Time for close : ',closeT, ' sec'
write(6, 2003) ' no. read calls : ',read_num, ' per process'
write(6, 2003) ' no. write calls : ',write_num,' per process'
write(6, 2004) ' total read amount : ',read_amount , ' GiB'
write(6, 2004) ' total write amount : ',write_amount , ' GiB'
write(6, 2004) ' read bandwidth : ',read_bandwidth , ' MiB/s'
write(6, 2004) ' write bandwidth : ',write_bandwidth , ' MiB/s'
write(6, 2000) ' -----------------------------------------------'
write(6, 2004) ' total I/O amount : ',io_amount , ' GiB'
write(6, 2004) ' total I/O time : ',io_time , ' sec'
write(6, 2004) ' I/O bandwidth : ',io_bandwidth, ' MiB/s'
endif
if (info_used .NE. MPI_INFO_NULL) &
call MPI_Info_free(info_used, err)
end subroutine print_io_performance
end module io_profiling_m