20 logical:: closed=.true.
21 character(len=64):: filename
23 procedure:: request_open
24 procedure:: request_close
25 procedure:: open_and_close
30 procedure,
private:: write1
31 procedure,
private:: write5
32 generic,
public ::
write => write1, write5
36 integer:: mpi_real=1, mpi_status_size=8
38 integer,
save:: verbose=2
44 SUBROUTINE request_open (self, filename)
46 character(len=*) filename
47 character(len=120):: id = &
48 '$Id: 1baebf6720d4e419e467bb40548dc47c63ba7563 $ mpi/mpi_file_mod.f90' 50 call trace%begin (
'mpi_file_t%request_open')
51 call trace%print_id (id)
54 self%mode = mpi_mode_create + mpi_mode_rdwr
55 self%filename = filename
60 END SUBROUTINE request_open
65 SUBROUTINE request_close (self)
68 call trace%begin (
'mpi_file_t%request_close')
71 END SUBROUTINE request_close
76 SUBROUTINE open_and_close (self)
79 call trace%begin (
'mpi_file_t%open_and_close',2)
80 if (self%closed .and. self%handle/=0)
then 82 write(io_unit%mpi,
'(g12.5,i4,2x,a)') wallclock(), omp%thread, &
83 'mpi_file_t%open_and_close: closed '//trim(self%filename)
85 else if (.not. self%closed .and. self%handle==0)
then 86 call self%openw (self%filename)
87 write(io_unit%mpi,
'(g12.5,i4,2x,a)') wallclock(), omp%thread, &
88 'mpi_file_t%open_and_close: opened '//trim(self%filename)
92 END SUBROUTINE open_and_close
99 SUBROUTINE open (self, filename, mode)
101 character(len=*) filename
106 integer(kind=MPI_OFFSET_KIND):: pos
111 if (self%handle == 0)
then 112 self%filename = filename
113 call mpi_file_open (mp%comm, filename, mode, mpi_info_null, self%handle, self%err)
114 if (io%verbose > 0)
then 115 write(io_unit%mpi,
'(a," status:",i4)') &
116 ' MPI_File_open: file='//trim(filename)//
' mode='// &
117 trim(merge(
'MPI_MODE_CREATE', &
118 ' ' ,iand(mode,mpi_mode_create) .ne. 0)) // &
119 trim(merge(
'+MPI_MODE_RDWR' , &
120 ' ' ,iand(mode,mpi_mode_rdwr) .ne. 0)) // &
121 trim(merge(
'MPI_MODE_RDONLY', &
122 ' ' ,iand(mode,mpi_mode_rdonly) .ne. 0)), self%err
126 self%closed = .false.
134 SUBROUTINE openw (self, filename, recl)
136 character(len=*) filename
137 integer,
optional:: recl
140 call trace%begin (
'mpi_file_t%openw')
142 if (mp%mode == mpi_thread_multiple)
then 143 call self%open (filename, mpi_mode_create + mpi_mode_rdwr)
146 call self%open (filename, mpi_mode_create + mpi_mode_rdwr)
150 if (
present(recl))
then 151 write (io%output,*)
'open:', trim(filename), recl
152 open (unit=io_unit%direct, file=filename, access=
'direct', recl=recl, &
162 SUBROUTINE openr (self, filename)
164 character(len=*) filename
167 call trace%begin (
'mpi_file_t%openr')
169 if (mp%mode == mpi_thread_multiple)
then 170 call self%open (filename, mpi_mode_rdonly)
173 call self%open (filename, mpi_mode_rdonly)
186 SUBROUTINE close (self)
189 call trace%begin (
'mpi_file_t%close')
191 if (self%handle /= 0)
then 192 if (mp%mode == mpi_thread_multiple)
then 193 call mpi_file_close (self%handle, self%err)
196 call mpi_file_close (self%handle, self%err)
199 if (io%verbose > 0)
then 200 write (io_unit%mpi,
'(1x,a,i8)') &
201 'mpi_file_t%close: '//trim(self%filename)//
' err:', self%err
213 SUBROUTINE write1 (self, off, size, buffer)
216 integer:: size, st(mpi_status_size), err
219 call trace%begin (
'mpi_io_t%write1')
221 if (mp%mode == mpi_thread_multiple)
then 222 call mpi_file_write_at (self%handle, off, buffer,
size, mpi_real, st, err)
225 call mpi_file_write_at (self%handle, off, buffer,
size, mpi_real, st, err)
230 END SUBROUTINE write1
235 SUBROUTINE write5 (self, off, size, buffer)
238 integer:: size, st(mpi_status_size), err
239 real:: buffer(:,:,:,:,:)
241 call trace%begin (
'mpi_io_t%write5')
243 if (mp%mode == mpi_thread_multiple)
then 244 call mpi_file_write_at (self%handle, off, buffer,
size, mpi_real, st, err)
247 call mpi_file_write_at (self%handle, off, buffer,
size, mpi_real, st, err)
252 END SUBROUTINE write5
257 SUBROUTINE assert (self, label, err)
259 character(len=*):: label
260 logical,
optional:: err
262 if (
present(err))
then 264 call mp%abort (label)
266 else if (self%err /= 0)
then 267 print*,mp%rank,
'error =',self%err
268 call mp%abort (label)
270 END SUBROUTINE assert
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Module for handling blocking and non-blocking MPI parallel I/O to a single file.