SIONlib  1.7.7
Scalable I/O library for parallel access to task-local files
fpartest.F90
1 !/****************************************************************************
2 !** SIONLIB http://www.fz-juelich.de/jsc/sionlib **
3 !*****************************************************************************
4 !** Copyright (c) 2008-2019 **
5 !** Forschungszentrum Juelich, Juelich Supercomputing Centre **
6 !** **
7 !** See the file COPYRIGHT in the package base directory for details **
8 !****************************************************************************/
9 program main
10 
11 #define MB *1024*1024
12 #define MAXPE 64*1024
13 #define MAXCHARLEN 256
14 #define sion_int64 integer*8
15 
16 !Enable or disable the checksum
17 !#define CHECKSUM
18 
19 !*****************************************************************************80
20 !
21 !! The main program that will execute the necessary tests
22 !
23  implicit none
24 !
25  include 'mpif.h'
26 
27 
28  integer ierr, np, rank, rankl
29  integer fsblksize
30  integer*8 totalsize, chunksize,bufsize
31  character, dimension(:),pointer :: localbuffer
32  character(len=MAXCHARLEN) :: filename = 'test_sionfile.sion'
33  character(len=MAXCHARLEN) :: newfname = 'newfile'
34 
35  integer :: narg, nfiles
36  character(len=256) argv
37 
38  logical collectiveread
39 
40  double precision gstarttime,starttime,opentime,gwritetime,writetime,closetime,readtime,greadtime
41  double precision barr1time,barr2time,barr3time
42 
43  integer*8 bsumwrote,sumsize,bsumread, left
44 
45  real*8 checksum_fp, checksum_read_fp
46  integer globalrank, sid, i
47 
48  integer*8 bwrite,bwrote,btoread,bread
49  integer feof
50 
51  integer chunkcnt,size1
52  integer*8 rchunksize
53  integer rblocksize
54 ! character(len=MAXCHARLEN) cbuffer
55 
56  integer comm,gComm,lComm
57 
58  call mpi_init(ierr)
59  call mpi_comm_size(mpi_comm_world, np, ierr)
60  call mpi_comm_rank(mpi_comm_world, rank, ierr)
61 
62  bufsize = 10 mb
63  totalsize = 20 mb
64  chunksize = bufsize
65  fsblksize = 2 mb ! IBM GPFS
66  nfiles = 1
67 
68  collectiveread = .true.
69 
70  if(rank == 0) then
71 ! parse command line
72  i=1
73  narg = command_argument_count()
74  do while( i < narg )
75  call get_command_argument(i, argv)
76 
77  if( argv(:1) == '-' ) then
78 
79  select case( argv(2:) )
80  case ('f')
81  i = i+1
82  call get_command_argument(i, argv)
83  filename = trim(argv)
84  case ('F')
85  i = i+1
86  call get_command_argument(i, argv)
87 
88  case ('b')
89  i = i+1
90  call get_command_argument(i, argv)
91  read(argv,'(I20)') bufsize
92  case ('B')
93  i = i+1
94  call get_command_argument(i, argv)
95  read(argv,'(I20)') bufsize
96  bufsize = bufsize mb
97  case ('s')
98  i = i+1
99  call get_command_argument(i, argv)
100  read(argv,'(I20)') totalsize
101  case ('n')
102  i = i+1
103  call get_command_argument(i, argv)
104  read(argv,'(I20)') nfiles
105  case ('S')
106  i = i+1
107  call get_command_argument(i, argv)
108  read(argv,'(I20)') totalsize
109  totalsize = totalsize mb
110  case ('r')
111  i = i+1
112  call get_command_argument(i, argv)
113  read(argv,'(I20)') chunksize
114  case ('R')
115  i = i+1
116  call get_command_argument(i, argv)
117  read(argv,'(I20)') chunksize
118  chunksize = chunksize mb
119  case ('q')
120  i = i+1
121  call get_command_argument(i, argv)
122  read(argv,'(I20)') fsblksize
123  case ('Q')
124  i = i+1
125  call get_command_argument(i, argv)
126  read(argv,'(I20)') fsblksize
127  fsblksize = fsblksize mb
128  case ('T')
129  i = i+1
130  call get_command_argument(i, argv)
131  if (argv /= '0') then
132  collectiveread = .true.
133  else
134  collectiveread = .false.
135  end if
136  case default
137  call get_command_argument(0, argv)
138  call usage(argv)
139  call exit(1)
140  end select
141  else
142  call get_command_argument(0, argv)
143  call usage(argv)
144  call exit(1)
145  end if
146  i = i+1
147  end do
148  end if
149 
150  call mpi_bcast(filename,maxcharlen,mpi_character,0,mpi_comm_world, ierr)
151  call mpi_bcast(bufsize,1,mpi_integer4,0,mpi_comm_world, ierr)
152  call mpi_bcast(totalsize,1,mpi_integer8,0,mpi_comm_world, ierr)
153  call mpi_bcast(chunksize,1,mpi_integer8,0,mpi_comm_world, ierr)
154  call mpi_bcast(fsblksize,1,mpi_integer,0,mpi_comm_world, ierr)
155  call mpi_bcast(collectiveread,1,mpi_logical,0,mpi_comm_world, ierr)
156  call mpi_bcast(nfiles,1,mpi_integer,0,mpi_comm_world, ierr)
157 
158 
159  if (rank == 0) then
160 #ifndef CHECKSUM
161  write(0, '(A)') "partest parameter: Checksum DISABLED!!"," "
162 #endif
163  write(0, 100) "datafile", trim(filename)
164  write(0, 103) "number of files",nfiles
165 
166  write(0, 101) "local buffer size / task", bufsize, bufsize/(1.0 mb)
167  write(0, 101) "total data size / task", totalsize, totalsize/(1.0 mb)
168  write(0, 101) "sion chunk size", chunksize, chunksize/(1.0 mb)
169  write(0, 101) "fs block size", fsblksize, fsblksize/(1.0 mb)
170  write(0, 102) "Collective", collectiveread
171 
172 
173 100 format("partest parameter: ",a30,tr1," = ",a)
174 101 format("partest parameter: ",a30,tr1," = ",i10," bytes (",f10.4," MB)")
175 102 format("partest parameter: ",a30,tr1," = ",l5)
176 103 format("partest parameter: ",a30,tr1," = ",i10)
177 
178  end if
179 
180  call barrier_after_start(mpi_comm_world)
181 
182  allocate( localbuffer(bufsize) )
183  localbuffer(:) = achar(ichar('a')+rank)
184 
185  call barrier_after_malloc(mpi_comm_world)
186 
187  size1 = np
188  comm = mpi_comm_world
189 ! lcomm = MPI_COMM_WORLD
190  gcomm = comm
191  globalrank = rank
192 
193 ! ****************************** WRITE *****************************
194 ! TODO: REMOVE TRIM
195  starttime = mpi_wtime()
196  call fsion_paropen_mpi(trim(filename),'bw',nfiles, gcomm,lcomm,chunksize,fsblksize,globalrank,newfname,sid)
197 
198  if (rank == 0) then
199  write(0, 101) "fs block size (calc)", fsblksize, fsblksize/(1.0 mb)
200  end if
201 
202  opentime = mpi_wtime() - starttime
203 
204  call mpi_comm_rank(lcomm, rankl, ierr)
205 
206 ! write(0, "(A30,I20)") "WF: after open", rank
207 
208  starttime = mpi_wtime()
209  call barrier_after_open(lcomm)
210  barr1time = mpi_wtime()-starttime
211 
212  checksum_fp = 0
213  left = totalsize
214  bsumwrote = 0
215  chunkcnt = 0
216 
217  starttime = mpi_wtime()
218  gstarttime = starttime
219  ! Fortran 90 specific!
220  do while(left > 0)
221  bwrite = bufsize
222  if (bwrite > left) bwrite = left
223 
224  call fsion_ensure_free_space(sid,bwrite,ierr)
225  call fsion_write(localbuffer, 1, bwrite, sid, bwrote)
226 ! write(0, "(A30,I2,I10,I10)") "WF: after write", rank, bwrite,bwrote
227 
228 #ifdef CHECKSUM
229  do i=1,bwrote
230  checksum_fp = checksum_fp + real(iachar(localbuffer(i)))
231  end do
232 #endif
233 
234  left = left - bwrote
235  bsumwrote = bsumwrote + bwrote
236  chunkcnt = chunkcnt + 1
237 
238 ! if (rank == 0) write(0, *) 'Chunk ',chunkcnt,': Wrote ', bwrote,'bytes data! Left: ',left
239  end do
240 
241  writetime = mpi_wtime() - starttime
242 
243  starttime = mpi_wtime()
244  call barrier_after_write(lcomm)
245  barr2time = mpi_wtime() - starttime
246  gwritetime = mpi_wtime() - gstarttime
247 
248  starttime = mpi_wtime()
249  call fsion_parclose_mpi(sid,ierr)
250  closetime = mpi_wtime() - starttime
251 
252  starttime = mpi_wtime()
253  call barrier_after_close(lcomm)
254  barr3time = mpi_wtime()-starttime
255 
256  if (writetime == 0) writetime = -1
257 
258 ! if(verbose) {
259 ! sprintf(cbuffer,"timings[%03d] open=%10.6fs write=%10.6fs close=%10.6fs
260 ! barrier(open=%10.6fs, write=%10.6fs, close=%10.6fs) #chunks=%d bw=%10.4f MB/s ionode=%d\n",
261 ! rank1,opentime,writetime,closetime,
262 ! barr1time,barr2time,barr3time,chunkcnt,
263 ! totalsize/1024.0/1024.0/writetime,rank3);
264 ! collective_print_gather(cbuffer,comm1);
265 ! }
266 
267  if (nfiles > 1) then
268  call mpi_reduce(bsumwrote, sumsize, 1, mpi_integer8, mpi_sum, 0, lcomm, ierr)
269  if(rankl == 0) then
270  write (0,111) 1.0*sumsize/1024.0/1024.0, newfname
271 111 format("Write partest result: wrote ",f10.4," MB to >",a30,"<")
272  end if
273  end if
274 
275  call mpi_reduce(bsumwrote, sumsize, 1, mpi_integer8, mpi_sum, 0, gcomm, ierr)
276  call mpi_barrier(gcomm,ierr)
277 
278  if (rank == 0) then
279  write(0,'(A)') "-----------------------------------------------------------------------"
280  write(0,112) 1.0*sumsize/1024.0/1024.0, gwritetime, 1.0*sumsize/1024.0/1024.0/gwritetime
281 
282 112 format("TOTAL: Write partest result: wrote ",f10.4," MB write+barrier= ",f10.6,"s bw= ",f10.4," MB/s")
283  write(0,'(A)') "-----------------------------------------------------------------------"
284  end if
285 
286  if (nfiles > 1) then
287  call mpi_barrier(lcomm,ierr)
288  call mpi_comm_free(lcomm,ierr)
289  end if
290 
291  if (rank == 0) write(0,'(A)') "***********************************************************************"
292 
293 ! ****************************** READ *****************************
294  localbuffer(:) = ' '
295 
296  starttime = mpi_wtime();
297  if (collectiveread) then
298  call fsion_paropen_mpi(trim(filename),'br',nfiles, gcomm,lcomm,chunksize,fsblksize,globalrank,newfname,sid)
299  else
300  call fsion_open_rank(trim(filename),"br",rchunksize,rblocksize,rank,sid)
301  end if
302 
303  opentime = mpi_wtime()-starttime
304 
305  call mpi_comm_rank(lcomm, rankl, ierr)
306 
307  starttime = mpi_wtime()
308  call barrier_after_open(lcomm)
309  barr1time = mpi_wtime()-starttime
310 
311  starttime = mpi_wtime()
312  gstarttime = starttime
313 
314  checksum_read_fp = 0
315  left = totalsize
316  bsumread = 0
317  chunkcnt = 0
318 
319  call fsion_feof(sid,feof)
320 
321  do while( (left > 0) .AND. (feof /= 1 ) )
322  btoread=bufsize
323 
324  if( btoread>left ) btoread = left
325 
326  call fsion_read(localbuffer, 1, btoread, sid, bread)
327 
328 #ifdef CHECKSUM
329  do i=1,bread
330  checksum_read_fp = checksum_read_fp + real(iachar(localbuffer(i)))
331  end do
332 #endif
333 
334  left = left - bread
335  bsumread = bsumread + bread
336  chunkcnt = chunkcnt + 1
337 ! if (rank == 0) write(0, *) 'Chunk ',chunkcnt,': Read ', bread,'bytes data! Left: ',left
338 
339  call fsion_feof(sid,feof)
340  end do
341 
342  readtime = mpi_wtime()-starttime
343 
344  starttime = mpi_wtime()
345  call barrier_after_read(lcomm)
346  barr2time = mpi_wtime()-starttime
347 
348  greadtime = mpi_wtime()-gstarttime
349 
350  starttime = mpi_wtime()
351  if(collectiveread) then
352  call fsion_parclose_mpi(sid,ierr)
353  else
354  call fsion_close(sid,ierr)
355  end if
356  closetime = mpi_wtime()-starttime
357 
358  if(readtime == 0) readtime = -1
359 
360 #ifdef CHECKSUM
361  if (abs(checksum_fp-checksum_read_fp)>1e-5) then
362  write(0,*)"ERROR in double checksum ",checksum_fp,"!=",checksum_read_fp," diff=",(checksum_fp-checksum_read_fp)
363  end if
364 #endif
365 
366  if (nfiles > 1) then
367  call mpi_reduce(bsumread, sumsize, 1, mpi_integer8, mpi_sum, 0, lcomm, ierr)
368  if(rankl == 0) then
369  write (0,113) 1.0*sumsize/1024.0/1024.0, newfname
370 113 format("Read partest result: read ",f10.4," MB from >",a30,"<")
371  end if
372  end if
373 
374 
375 
376  call mpi_reduce(bsumread, sumsize, 1, mpi_integer8, mpi_sum, 0, gcomm, ierr)
377  call mpi_barrier(gcomm,ierr)
378 
379  if (rank == 0) then
380  write(0,'(A)') "-----------------------------------------------------------------------"
381  write(0,114) 1.0*sumsize/1024.0/1024.0, greadtime, 1.0*sumsize/1024.0/1024.0/greadtime
382 
383 114 format("TOTAL: Read partest result: read ",f10.4," MB read+barrier= ",f10.6,"s bw= ",f10.4," MB/s")
384  write(0,'(A)') "-----------------------------------------------------------------------"
385  end if
386 
387  if (nfiles > 1) then
388  call mpi_barrier(lcomm,ierr)
389  call mpi_comm_free(lcomm,ierr)
390  end if
391 ! ****************************** END *****************************
392  deallocate(localbuffer)
393 
394  call mpi_finalize(ierr)
395  stop
396 end
397 
398 subroutine barrier_after_start(comm)
399  integer, intent(in) :: comm
400  integer ierr
401  call mpi_barrier(comm,ierr)
402 end
403 
404 subroutine barrier_after_malloc(comm)
405  integer, intent(in) :: comm
406  integer ierr
407 
408  call mpi_barrier(comm,ierr)
409 end
410 
411 subroutine barrier_after_open(comm)
412  integer, intent(in) :: comm
413  integer ierr
414  call mpi_barrier(comm,ierr)
415 return
416 end
417 
418 subroutine barrier_after_write(comm)
419  integer, intent(in) :: comm
420  integer ierr
421  call mpi_barrier(comm,ierr)
422 end
423 
424 subroutine barrier_after_read(comm)
425  integer, intent(in) :: comm
426  integer ierr
427  call mpi_barrier(comm,ierr)
428 end
429 
430 subroutine barrier_after_close(comm)
431  integer, intent(in) :: comm
432  integer ierr
433  call mpi_barrier(comm,ierr)
434 end
435 
436 subroutine collective_print_gather ( cbuffer, comm)
437  character, dimension(:), intent(in) :: cbuffer
438  integer, intent(in) :: comm
439 
440  integer rank, np, p, ierr
441  character, dimension(:), allocatable :: lbuffer
442 
443  ! Allocate the memory for this array
444  allocate( lbuffer(maxcharlen*maxpe) )
445 
446  call mpi_comm_size(comm, np, ierr)
447  call mpi_comm_rank(comm, rank, ierr)
448 
449  call mpi_gather(cbuffer, maxcharlen, mpi_character, lbuffer, maxcharlen, mpi_character, 0, comm, ierr)
450 
451  if(rank .EQ. 0) then
452  do p = 0, np
453  write(0,*) lbuffer( (p*maxcharlen+1):((p+1)*maxcharlen) )
454  end do
455  end if
456 
457  ! Free the memory of this array
458  deallocate(lbuffer)
459 end
460 
461 subroutine usage(name)
462  character(len=64), intent(in) :: name
463 
464  write(0, '(A,A,A,/,A)') "Usage: ",trim(name)," <options>",&
465  "with the following optional options (default values in parathesis)"
466  write(0, '(/,A)') " Sion File Settings:"
467  write(0, *) " [-f filename] filename of direct access file"
468  write(0, *) " [-r <chunksize>] sion chunk size in bytes"
469  write(0, *) " [-R <chunksize>] sion chunk size in MBytes"
470  write(0, *) " [-q <fsblksize>] size of filesystem blocks in bytes"
471  write(0, *) " [-Q <fsblksize>] size of filesystem blocks in MBytes"
472 
473  write(0, *) " [-b <bufsize>] size of blocks written in ONE fwrite in bytes"
474  write(0, *) " [-B <bufsize>] size of blocks written in ONE fwrite in MBytes"
475  write(0, *) " [-s <totalsize>] total size of data written by each processor in bytes"
476  write(0, *) " [-S <totalsize>] total size of data written by each processor in MBytes"
477  write(0, *) " [-T <type>] type of test (0): w/o collective read "
478 
479 end
480 
Generated by doxygen 1.9.1