55 real,
dimension(:,:,:,:,:,:),
pointer:: buffer => null()
57 procedure,
nopass:: init
58 procedure,
nopass:: input
59 procedure,
nopass:: output
60 procedure,
nopass:: close
61 procedure,
nopass:: open_and_close
63 integer,
save:: verbose=0
64 logical:: check_files=.false.
65 type(
mpi_file_t),
pointer:: file_in=>null(), file_out=>null()
66 type(
mpi_file_t),
pointer,
dimension(:):: files_out=>null()
68 integer,
save:: io0, io1
69 integer,
save:: opened=-1, closed=-1
76 SUBROUTINE init (patch)
79 character(len=5):: snapname
80 character(len=120):: filename
83 logical:: first_time=.true.
84 namelist /parallel_io_params/ verbose
85 character(len=120):: id = &
86 '$Id: d936aa6f2f05c80e7a6feced2da2dce6d4019b39 $ io/parallel_io_mod.f90' 88 call trace%print_id (id)
89 call trace%begin (
'parallel_io_t%init')
93 rewind(io%input);
read(io%input, parallel_io_params, iostat=iostat)
94 write (io%output, parallel_io_params)
96 call io%abort (
'parallel_io_t%init: io%ntask == 0')
98 call mpi_io%set (nwrite=io%nwrite*(io%time_derivs+1))
99 if (io%method==
'parallel')
then 101 write (filename,
'(a,"/snapshots.dat")') trim(io%outputname)
102 call file_out%openw (filename)
106 call time_slices%init (patch%nt)
116 call trace%begin (
'parallel_io_t%close')
117 if (io%method ==
'snapshot')
then 119 call files_out(i)%close
131 SUBROUTINE open_and_close ()
137 if (check_files)
then 139 if (check_files)
then 141 check_files = .false.
143 call trace%begin (
'parallel_io_t%open_and_close')
144 if (
associated(files_out))
then 146 call files_out(i)%open_and_close()
152 if (verbose > 1)
then 153 write (io_unit%log,*) wallclock(),
'parallel_io_t%open_and_close: exiting' 157 END SUBROUTINE open_and_close
162 SUBROUTINE output (patch, count)
166 integer(8):: snapshot_words, buffer_words, pos
167 integer:: iv, n(3), jt(2), iw, nw
168 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: mem
169 real(kind=4),
dimension(:,:,:,:),
pointer:: buffer
170 character(len=120):: filename
172 logical,
save:: first_time=.true.
173 integer,
save:: itimer=0
175 call trace%begin (
'parallel_io_t%output', itimer=itimer)
176 if (io%format > 9 .and. io%format < 14)
then 177 call output_single (patch, count)
178 call trace%end (itimer)
184 if (.not.
associated(file_out))
then 185 write (filename,
'(a,"/snapshots.dat")') trim(io%outputname)
187 call file_out%openw (filename)
193 if (io%guard_zones)
then 203 snapshot_words = product(n)*io%nv*io%ntotal
204 buffer_words = product(n)*io%nv
205 if (io%method ==
'snapshot')
then 206 call mpi_io%use (files_out(patch%iout))
208 call mpi_io%use (file_out)
210 call mpi_io%set (snapshot_words, buffer_words, io%nwrite*(io%time_derivs+1))
216 write(io%output,
'(a,f8.3,a,i10,a)') &
217 ' output snapshot size =', snapshot_words*4d0/1024d0**3,
' GB, in', &
218 io%ntotal,
' patches' 219 write(io%output,
'(a,4i6,2i12)') &
220 ' parallel_io_t%output: iout, n, snapshot_words, buffer_words =', &
221 patch%iout, n, snapshot_words, buffer_words
226 allocate (mem(n(1),n(2),n(3),patch%nt))
227 allocate (buffer(n(1),n(2),n(3),io%nv))
229 call convert_variables
230 call time_slices%interpolate (patch, mem, buffer(:,:,:,iv))
232 call io_write ((io%time_derivs+1)*patch%iout, 0)
236 if (io%time_derivs>0)
then 238 call convert_variables
239 call time_slices%derivative1 (patch, mem, buffer(:,:,:,iv))
241 call io_write ((io%time_derivs+1)*patch%iout, 1)
242 if (io%time_derivs==2)
then 244 call convert_variables
245 call time_slices%derivative2 (patch, mem, buffer(:,:,:,iv))
247 call io_write ((io%time_derivs+1)*patch%iout, 2)
256 call trace%end (itimer)
263 subroutine convert_variables
264 integer:: nt1, l(3), u(3), i, j, k
266 call trace%begin (
'parallel_io-t%output::convert_variables')
267 if (io%guard_zones)
then 269 u = max(patch%mesh%ub,patch%mesh%gn)
275 if (io%format >= 8 .and. iv==patch%idx%d)
then 277 do k=l(3),u(3);
do j=l(2),u(2);
do i=l(1),u(1)
278 mem(i-l(1)+1,j-l(2)+1,k-l(3)+1,1:nt1) &
279 = log(patch%mem(i,j,k,iv,patch%iit(1:nt1),1))
280 end do; end do; end do
281 else if ((io%format == 6 .or. io%format==8) .and. patch%solver_is(
'ramses') &
282 .and. iv >= patch%idx%px .and. iv <= patch%idx%pz)
then 284 do k=l(3),u(3);
do j=l(2),u(2);
do i=l(1),u(1)
285 mem(i-l(1)+1,j-l(2)+1,k-l(3)+1,1:nt1) &
286 = patch%mem(i,j,k,iv,patch%iit(1:nt1),1) &
287 / patch%mem(i,j,k,patch%idx%d,patch%iit(1:nt1),1)
288 end do; end do; end do
290 mem = patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,patch%iit(1:nt1),1)
295 subroutine io_write (slot, ider)
304 if (io%method ==
'pan')
then 305 call mpi_io%iwrite (buffer, 1+ider+slot, patch%id)
313 call mpi_io%iwrite (buffer, 1+slot, 1+ider+(patch%id-1)*(io%time_derivs+1))
316 END SUBROUTINE output
321 SUBROUTINE output_single (patch, count)
322 class(patch_t):: patch
325 integer(8):: snapshot_words, buffer_words, pos
326 integer:: iv, n(3), jt(2), iw, nw, nder, irec, ider, ip, i, iout
327 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: mem
328 real(kind=4),
dimension(:,:,:),
pointer:: buffer
331 logical:: first_time=.true.
332 character(len=120):: filename
333 integer,
save:: itimer=0
335 call trace%begin (
'parallel_io_t%output_single', itimer=itimer)
339 if (verbose > 1)
then 340 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' begin' 343 if (io%method ==
'snapshot')
then 344 if (.not.
associated(files_out))
then 346 io1 = io0 + nint((io%end_time-patch%out_next)/io%out_time) + 1
348 if (verbose > 0 .and. omp%master)
then 349 write (io_unit%log,
'(a,i4," -- ",i4)') &
350 'parallel_io_t%output: initializing for snapshots', io0, io1
352 allocate (files_out(io0:io1))
354 write (filename,
'(a,"/",i5.5,"/snapshot.dat")') trim(io%outputname), i
355 call files_out(i)%openw (filename)
361 if (patch%iout+1 > opened)
then 363 opened = patch%iout+1
364 write (filename,
'(a,"/",i5.5,"/snapshot.dat")') trim(io%outputname), opened
365 if (verbose > 1)
then 366 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' request_open' 369 call files_out(opened)%request_open (filename)
378 if (verbose > 1)
then 379 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' set size' 382 if (io%guard_zones)
then 390 if (verbose > 1)
then 391 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' call mpi_io' 395 call io%abort (
'parallel_io_t%output_single: io%ntask == 0')
397 nder = io%time_derivs+1
398 snapshot_words = product(n)*io%ntotal*io%nv*nder
399 buffer_words = product(n)*io%ntask
400 if (io%method ==
'snapshot')
then 401 call mpi_io%use (files_out(patch%iout))
403 call mpi_io%use (file_out)
410 write(io%output,
'(a,f8.3,a,i10,a)') &
411 ' output snapshot size =', snapshot_words*4d0/1024d0**3,
' GB, in', &
412 io%ntotal,
' patches' 413 write(io%output,
'(a,4i6,2i12)') &
414 ' parallel_io_t%output: iout, n, snapshot_words, buffer_words =', &
415 patch%iout, n, snapshot_words, buffer_words
418 call mpi_io%set (snapshot_words, buffer_words, 99)
420 if (.not.
associated(parallel_io%buffer))
then 421 allocate (parallel_io%buffer(n(1),n(2),n(3),io%ntask,io%nv,nder))
423 write (io%output,*)
'shape io%buffer =', shape(parallel_io%buffer)
427 if (ip < 0 .or. ip > io%ntask .and. patch%time < io%end_time)
then 428 write (io_unit%output,*) &
429 'parallel_io_t%output_single: WARNING io, ntask =', ip, io%ntask
430 ip = max(1,min(ip,io%ntask))
432 if (verbose > 0)
then 433 write(io%output,
'(a,6i6,2i12,l3)') &
434 ' parallel_io_t%output_single: id, ip, iout, n, snapshot_words, buffer_words =', &
435 patch%id, ip, patch%iout, n, snapshot_words, buffer_words,
associated(parallel_io%buffer)
438 if (verbose > 1)
then 439 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' allocate mem' 442 allocate (mem(n(1),n(2),n(3),patch%nt-1))
446 if (verbose > 1)
then 447 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' convert var, interpolate' 451 call convert_variables
452 buffer => parallel_io%buffer(:,:,:,ip,iv,1)
453 call time_slices%interpolate (patch, mem, buffer)
458 if (io%time_derivs>0)
then 460 call convert_variables
461 buffer => parallel_io%buffer(:,:,:,ip,iv,2)
462 call time_slices%derivative1 (patch, mem, buffer)
464 if (io%time_derivs==2)
then 466 call convert_variables
467 buffer => parallel_io%buffer(:,:,:,ip,iv,3)
468 call time_slices%derivative2 (patch, mem, buffer)
473 if (verbose > 0)
then 474 write (io_unit%log,*) wallclock(), patch%id, patch%time, count,
' buffer' 478 if (io%method ==
'snapshot')
then 480 file_out => files_out(patch%iout)
485 if (verbose > 0)
then 486 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' start:'//trim(file_out%filename)
496 irec = 1 + mpi%rank + mpi%size*(iv-1 + (ider-1)*io%nv)
498 write (io_unit%output,*)
'write(1): irec, iout =', irec, iout
499 write (io_unit%log,*)
'mpi_io%write: iout, irec =', 1+iout, irec
500 call mpi_io%write (parallel_io%buffer(:,:,:,:,iv,ider), 1+iout, irec)
503 if (verbose > 0)
then 504 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' end:'//trim(file_out%filename)
507 write (io_unit%log,
'(a,f7.3,1x,a)') &
508 'parallel_io_t%output_single: MPI_File_write_at I/O', wallclock()-start,
'sec' 509 if (io%method ==
'snapshot')
then 511 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' request_close' 512 if (patch%iout-1 > closed)
then 514 closed = patch%iout-1
515 call files_out(closed)%request_close ()
521 if (verbose > 1)
then 522 write (io_unit%log,*) wallclock(), patch%id, patch%time,
' END' 525 call trace%end (itimer)
533 subroutine convert_variables
534 integer:: nt1, l(3), u(3), i, j, k
536 call trace%begin (
'parallel_io-t%output_single::convert_variables')
537 if (io%guard_zones)
then 539 u = max(patch%mesh%ub,patch%mesh%gn)
545 if (io%format >= 12 .and. iv==patch%idx%d)
then 547 do k=l(3),u(3);
do j=l(2),u(2);
do i=l(1),u(1)
548 mem(i-l(1)+1,j-l(2)+1,k-l(3)+1,1:nt1) &
549 = log(patch%mem(i,j,k,iv,patch%iit(1:nt1),1))
550 end do; end do; end do
551 else if ((io%format == 10 .or. io%format==12) .and. patch%solver_is(
'ramses') &
552 .and. iv >= patch%idx%px .and. iv <= patch%idx%pz)
then 554 do k=l(3),u(3);
do j=l(2),u(2);
do i=l(1),u(1)
555 mem(i-l(1)+1,j-l(2)+1,k-l(3)+1,1:nt1) &
556 = patch%mem(i,j,k,iv,patch%iit(1:nt1),1) &
557 / patch%mem(i,j,k,patch%idx%d,patch%iit(1:nt1),1)
558 end do; end do; end do
560 mem = patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,patch%iit(1:nt1),1)
564 END SUBROUTINE output_single
569 SUBROUTINE input (patch, ok)
570 class(patch_t):: patch
573 integer(8):: snapshot_words, buffer_words
574 integer:: iv, n(3), slot
575 real,
dimension(:,:,:,:),
pointer:: buffer
576 character(len=120):: filename
577 logical:: single_patch
578 logical,
save:: first_time=.true.
579 integer,
save:: itimer=0
581 call trace%begin (
'parallel_io_t%input', itimer=itimer)
587 if (patch%is_set(bits%virtual))
then 590 call trace%end (itimer)
596 if (io%method ==
'snapshot')
then 597 write (filename,
'(a,"/",i5.5,"/snapshot.dat")') &
598 trim(io%outputname), io%restart
600 filename=trim(io%inputdir)//
'snapshots.dat' 603 call file_in%openr (filename)
607 if (io%format > 9 .and. io%format < 14)
then 608 call input_single (patch, ok)
609 call trace%end (itimer)
615 if (file_in%handle==0)
then 618 if (io%guard_zones)
then 626 single_patch = any(io%mpi_odims/=io%mpi_dims)
630 snapshot_words = product(n)*io%ntotal*io%nv*(io%time_derivs+1)
631 if (single_patch)
then 632 buffer_words = product(n)
634 buffer_words = product(n)*io%ntask
642 write(io%output,
'(a,f8.3,a,i10,a)') &
643 ' output snapshot size =', snapshot_words*4d0/1024d0**3,
' GB, in', &
644 io%ntotal,
' patches' 645 write(io%output,
'(a,4i6,2i12)') &
646 ' parallel_io_t%output: iout, n, snapshot_words, buffer_words =', &
647 patch%iout, n, snapshot_words, buffer_words
651 call mpi_io%use (file_in)
652 call mpi_io%set (snapshot_words, buffer_words, io%nwrite*(io%time_derivs+1))
657 allocate (buffer(n(1),n(2),n(3),io%nv))
658 patch%iout = io%restart
659 slot = (io%time_derivs+1)*patch%iout
660 call mpi_io%read (buffer, 1+slot, 1+(patch%id-1)*(io%time_derivs+1))
661 if (mpi_io%err /= 0)
then 663 call trace%end (itimer)
666 if (io%guard_zones)
then 667 patch%mem(:,:,:,1:io%nv,patch%it,1) = buffer
669 patch%mem(patch%li(1):patch%ui(1), &
670 patch%li(2):patch%ui(2), &
671 patch%li(3):patch%ui(3),1:io%nv,patch%it,1) = buffer
673 if (verbose > 1)
then 675 write (io_unit%output,*)
'parallel_io_t%input: id, iv, iout, min, max =', &
676 patch%id, iv, patch%iout, patch%fminval(iv), patch%fmaxval(iv)
678 else if (verbose > 0)
then 679 write (io_unit%output,*)
'parallel_io_t%input: id, iout =', &
684 call convert_variables
689 patch%t(patch%iit) = patch%time
695 write(io%output,
'(a,2i6,1p,2e16.6)')
' parallel_io_t%input: iout, id, time, dtime =', &
696 patch%iout, patch%id, patch%time, patch%dtime
698 write(io%output,
'(a,4i6,2i7)') &
699 ' parallel_io_t%input: iout, n, snapshot_words, buffer_words =', &
700 patch%iout, n, snapshot_words, buffer_words
701 call trace%end (itimer)
707 subroutine convert_variables
711 if (io%format >= 8 .and. iv==patch%idx%d)
then 713 patch%mem(:,:,:,iv,:,1) = exp(patch%mem(:,:,:,iv,:,1))
718 if ((io%format == 6 .or. io%format==8) .and. patch%solver_is(
'ramses') &
719 .and. iv >= patch%idx%px .and. iv <= patch%idx%pz)
then 721 patch%mem(:,:,:,iv,:,1) = patch%mem(:,:,:,iv,:,1)*patch%mem(:,:,:,patch%idx%d,:,1)
730 SUBROUTINE input_single (patch, ok)
731 class(patch_t):: patch
734 integer(8):: snapshot_words, buffer_words
735 integer:: iv, n(3), slot, nder, irec, ip, iout, rank, nrank
736 logical,
save:: read_failed=.false., first_time=.true.
737 integer,
save:: itimer=0
738 real,
allocatable:: buffer(:,:,:)
739 logical:: single_patch
741 call trace%begin (
'parallel_io_t%input_single', itimer=itimer)
747 if (patch%is_set(bits%virtual))
then 750 call trace%end (itimer)
756 if (file_in%handle==0)
then 759 if (io%guard_zones)
then 767 single_patch = any(io%mpi_odims/=io%mpi_dims)
773 call io%abort (
'parallel_io_t%input_single: io%ntask == 0')
775 nder = io%time_derivs+1
776 snapshot_words = product(n)*io%ntotal*io%nv*nder
777 if (single_patch)
then 778 buffer_words = product(n)
780 buffer_words = product(n)*io%ntask
784 if (.not.
associated(parallel_io%buffer))
then 785 allocate (parallel_io%buffer(n(1),n(2),n(3),io%ntask,io%nv,nder))
787 write (io%output,*)
'shape io%buffer =', shape(parallel_io%buffer)
791 call mpi_io%use (file_in)
792 call mpi_io%set (snapshot_words, buffer_words, 99)
796 patch%iout = io%restart
798 if (single_patch)
then 805 write(io%output,
'(a,f8.3,a,i10,a)') &
806 ' output snapshot size =', snapshot_words*4d0/1024d0**3,
' GB, in', &
807 io%ntotal,
' patches' 808 write(io%output,
'(a,4i6,2i12)') &
809 ' parallel_io_t%output: iout, n, snapshot_words, buffer_words =', &
810 patch%iout, n, snapshot_words, buffer_words
815 allocate (buffer(n(1),n(2),n(3)))
820 nrank = product(io%mpi_odims)
821 rank = mpi_coords%coords_to_rank (patch%ipos*io%mpi_odims/io%dims)
822 if (verbose > 0)
then 824 write (io_unit%output,
'(a,i6,4(2x,3i5))') &
825 'single_patch: id, ip, rank, nrank, per_rank, ipos =', &
826 patch%id, ip, rank, nrank, io%dims/io%mpi_odims, patch%ipos, &
830 irec = 1 + rank + nrank*(iv-1)
832 write (io_unit%output,*)
'read(1): irec, iout =', irec, patch%iout
833 call mpi_io%read (buffer, 1+patch%iout, irec)
834 if (io%guard_zones)
then 835 patch%mem(:,:,:,iv,patch%it,1) = buffer
837 patch%mem(patch%li(1):patch%ui(1), &
838 patch%li(2):patch%ui(2), &
839 patch%li(3):patch%ui(3),iv,patch%it,1) = buffer
850 write(io%output,
'(a,f8.3,a,i10,a)') &
851 ' output snapshot size =', snapshot_words*4d0/1024d0**3,
' GB, in', &
852 io%ntotal,
' patches' 853 write(io%output,
'(a,4i6,2i12)') &
854 ' parallel_io_t%output: iout, n, snapshot_words, buffer_words =', &
855 patch%iout, n, snapshot_words, buffer_words
860 if (io%method ==
'snapshot')
then 866 irec = 1 + mpi%rank + mpi%size*(iv-1)
868 write (stdout,*)
'read(2): irec, iout =', irec, iout
869 call mpi_io%read (parallel_io%buffer(:,:,:,:,iv,1), 1+iout, irec)
870 if (mpi_io%err /= 0)
then 872 write(io%output,*)
'io%input_single: read failed', io%restart
876 if (.not.read_failed) &
877 write(io%output,*)
'io%input_single: read succeeded, snapshot', io%restart
882 if (read_failed)
then 884 call trace%end (itimer)
887 if (ip < 1 .or. ip > io%ntask)
then 888 write (io_unit%output,*) &
889 'parallel_io_t%input_single: WARNING io, ntask =', ip, io%ntask
890 flush (io_unit%output)
891 ip = max(1,min(ip,io%ntask))
893 if (io%guard_zones)
then 894 patch%mem(:,:,:,:,patch%it,1) = parallel_io%buffer(:,:,:,ip,:,1)
896 patch%mem(patch%li(1):patch%ui(1), &
897 patch%li(2):patch%ui(2), &
898 patch%li(3):patch%ui(3),:,patch%it,1) = parallel_io%buffer(:,:,:,ip,:,1)
901 if (verbose > 1)
then 903 write (io_unit%output,
'(a,i6,3i4,1p,2g14.6)') &
904 'parallel_io_t%input: id, ip, iv, iout, min, max =', &
905 patch%id, ip, iv, patch%iout, patch%fminval(iv), patch%fmaxval(iv)
907 else if (verbose > 0)
then 908 write (io_unit%output,*)
'parallel_io_t%input: id, ip, iout =', &
909 patch%id, ip, patch%iout
912 call convert_variables
917 patch%t(patch%iit) = patch%time
922 call trace%end (itimer)
928 subroutine convert_variables
930 call trace%begin(
'input_single::convert_variables')
931 if (io%guard_zones)
then 933 u = max(patch%mesh%ub,patch%mesh%gn)
941 if (io%format >= 12 .and. iv==patch%idx%d)
then 943 patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,:,1) = &
944 exp(patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,:,1))
948 else if ((io%format == 10 .or. io%format==12) .and. patch%solver_is(
'ramses') &
949 .and. iv >= patch%idx%px .and. iv <= patch%idx%pz)
then 951 patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,:,1) = &
952 patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),iv,:,1) * &
953 patch%mem(l(1):u(1),l(2):u(2),l(3):u(3),patch%idx%d,:,1)
957 END SUBROUTINE input_single
Compute time derivative from a sequence of time slices, using Lagrange interpolation.
Module for handling blocking and non-blocking MPI parallel I/O to a single file. The module is initia...
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Use MPI parallel I/O to write everything to a single file. No critical regions should be needed here;...
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
Module for handling blocking and non-blocking MPI parallel I/O to a single file.