DISPATCH
data_io_mod.f90
1 !===============================================================================
2 !> Interface from gpatch_mod to a choice of binary data I/O methods, controlled
3 !> by the io%method text string -- optionally (but deprecated) by io%do_legacy
4 !> or io%do_direct.
5 !>
6 !> Concerning thread safety: Simultaneous calls from many threads are typical,
7 !> and it is the responsibility of each sub-module here (e.g. parallel_io_mod)
8 !> to introduce critical regions to protect agains simultaneus calls to non-
9 !> threadsafe procedures, or if/when accessing modified shared data.
10 !>
11 !> To prevent other threads from getting into trouble while collective MPI calls
12 !> are being made, the io%halt flag is set while this is happening, and since
13 !> the data_io%open_and_close() procedure is called in every task_list%update
14 !> iteration, trap can be activated there, causing all threads except the one
15 !> doing collective MPI I/O calls to wait.
16 !===============================================================================
18  USE io_mod
19  USE os_mod
20  !USE aux_mod
21  USE mpi_mod
22  USE omp_mod
23  USE omp_timer_mod
24  USE omp_lock_mod
25  USE trace_mod
26  USE task_mod
27  USE patch_mod
28  USE amr_io_mod
29  USE direct_io_mod
30  USE legacy_io_mod
31  USE parallel_io_mod
32  USE buffered_io_mod
33  USE pdf_io_mod
34  USE counters_mod
35  USE index_mod
36  USE dll_mod
37  USE time_slices_mod
38  implicit none
39  private
40  type, public:: io_kind_t
41  character(len=64):: filename=''
42  class(patch_t), pointer:: patch=>null()
43  integer:: size=0, nv=0
44  end type
45  type, public:: data_io_t
46  logical:: initialized=.false.
47  type(dll_t):: kind_list
48  type(lock_t):: lock
49  type(counters_t):: counters
50  contains
51  procedure:: init
52  procedure:: update_counters
53  procedure:: register_kind
54  procedure:: output
55  procedure, nopass:: output_txt
56  procedure, nopass:: output_nml
57  procedure:: input
58  procedure, nopass:: close
59  procedure:: open_and_close
60  end type
61  type(data_io_t), public:: data_io
62 CONTAINS
63 
64 !===============================================================================
65 !> Initialize the I/O method, if not already done
66 !===============================================================================
67 SUBROUTINE init (self, task)
68  class(data_io_t):: self
69  class(patch_t):: task
70  !.............................................................................
71  logical, save:: first_time=.true.
72  character(len=120):: id = &
73  '$Id: 47ffa987be81f1602fb7b39a0982df4b90b8ed5b $ io/data_io_mod.f90'
74  !-----------------------------------------------------------------------------
75  call trace%begin('data_io_t%init')
76  call trace%print_id (id)
77  if (first_time) then
78  !$omp critical (data_io_cr)
79  if (first_time) then
80  if (io%do_output) then
81  call time_slices%init (task%nt)
82  select type (task)
83  class is (patch_t)
84  if (io%method=='direct') then
85  call direct_io%init (task)
86  else if (io%method=='amr') then
87  call amr_io%init (task)
88  else if (io%method=='pan') then
89  call parallel_io%init (task)
90  else if (io%method=='parallel') then
91  call parallel_io%init (task)
92  else if (io%method=='snapshot') then
93  call parallel_io%init (task)
94  end if
95  end select
96  end if
97  call self%lock%init ('data_io')
98  call self%kind_list%init
99  self%initialized = .true.
100  first_time = .false.
101  end if
102  !$omp end critical (data_io_cr)
103  end if
104  !-----------------------------------------------------------------------------
105  call self%counters%init
106  select type (task)
107  class is (patch_t)
108  call pdf_io%init (task)
109  end select
110  call trace%end()
111 END SUBROUTINE init
112 
113 !===============================================================================
114 !> Update I/O counters, when tasks are added or removed by refine_mod.
115 !===============================================================================
116 SUBROUTINE update_counters (self, patch, incr)
117  class(data_io_t):: self
118  class(patch_t):: patch
119  integer:: incr, count1, count2, iout
120  !-----------------------------------------------------------------------------
121  call trace%begin ('data_io_t%update_counters')
122  call self%lock%set ('update_counters')
123  !-----------------------------------------------------------------------------
124  ! Update the active counters, which may or may not already have been altered.
125  ! The relevant counter index is most reliably determined by the very value
126  ! that gets incremented in pdf_io_t%update(); i.e., patch%pdf_next.
127  !-----------------------------------------------------------------------------
128  if (pdf_io%on) then
129  iout = nint(patch%pdf_next/pdf_io%out_time)
130  call pdf_io%counters%update ( iout+1, io%nwrite, incr, count1)
131  end if
132  call self%counters%update (patch%iout+1, io%nwrite, incr, count2)
133  !-----------------------------------------------------------------------------
134  ! When tasks are added or removed, the number of tasks to reset the counters
135  ! to should be correspondingly updated.
136  !-----------------------------------------------------------------------------
137  io%ntask = io%ntask+incr
138  io%nwrite = io%ntask
139 !write(io_unit%log,'(a,f12.6,9i7)') &
140 !'update_counters: clk, thread, id, incr, io%nwrite, counts, iouts =', &
141 !wallclock(), omp%thread, patch%id, incr, io%nwrite, count1, count2, patch%iout, iout
142  call self%lock%unset ('update_counters')
143  call trace%end ()
144 END SUBROUTINE update_counters
145 
146 !===============================================================================
147 !> Register one type of task, for output into separate file
148 !===============================================================================
149 SUBROUTINE register_kind (self, patch)
150  class(data_io_t):: self
151  class(patch_t), pointer:: patch
152  class(dll_node_t), pointer:: item
153  type(io_kind_t), pointer:: io_kind
154  !-----------------------------------------------------------------------------
155  allocate (item, io_kind)
156  item%car => io_kind
157  io_kind%patch => patch
158  io_kind%filename = 'snapshot_'//trim(patch%kind)//'.dat'
159  io_kind%size = product(shape(patch%mem))
160  io_kind%nv = patch%nv
161  if (io%master) then
162  print '(1x,a,4x,a,i8,4x,a,i3)', &
163  'data_io_t%register_kind: filename = '//trim(io_kind%filename), &
164  'array size (words) =', io_kind%size, 'nv =', io_kind%nv
165  end if
166  call self%kind_list%append (item)
167 END SUBROUTINE register_kind
168 
169 !===============================================================================
170 !> Write results to disk
171 !===============================================================================
172 SUBROUTINE output (self, patch, experiment_name)
173  class(data_io_t):: self
174  class(patch_t):: patch
175  !.............................................................................
176  character(len=64) filename, logname, experiment_name
177  optional:: experiment_name
178  !.............................................................................
179  integer, save:: created=-1
180  integer, save:: itimer=0
181  logical:: append
182  integer:: it, count, np, prv
183  real(8):: t
184  !-----------------------------------------------------------------------------
185  call pdf_io%update (patch)
186  if (.not.io%do_output) return
187  call trace%begin('data_io_t%output', itimer=itimer)
188  !-----------------------------------------------------------------------------
189  ! If io%needs_check is set, this rank needs to check if all other ranks are
190  ! ready to do I/O, and if so, call the relevant I/O routine
191  !-----------------------------------------------------------------------------
192  call self%lock%set ('output1')
193  if (io%needs_check) then
194  if (io%method=='amr') then
195  call amr_io%check
196  end if
197  call self%lock%unset ('output1')
198  else
199  call self%lock%unset ('output1')
200  !---------------------------------------------------------------------------
201  ! io%nwrite is the number of task writes this process is doing per snapshot
202  ! it is given a default value here, which may be modified elsewhere in
203  ! data_io_mod, if more than one write per task is being performed.
204  !---------------------------------------------------------------------------
205  if (io%ntask<=0) then
206  call mpi%abort ('io%ntask, which should be the number of active tasks, is zero')
207  end if
208  if (io%ntotal<=0) then
209  call mpi%abort ('io%ntotal, which should be the total number of tasks, is zero')
210  end if
211  if (io%verbose > 1) &
212  write (io_unit%log,*) 'io%nwrite =', io%nwrite
213  !---------------------------------------------------------------------------
214  if (io%method=='legacy') then
215  np = 1
216  else
217  np = (time_slices%order+1)/2
218  end if
219  !$omp atomic read
220  it = patch%iit(patch%nt-np)
221  !$omp atomic read
222  t = patch%t(it)
223  if (t >= patch%out_next) then
224  call self%lock%set ('output2')
225  if (io%verbose > 1) &
226  write (io%output,*) wallclock(),' thread',omp%thread,' waitfor output'
227  !-------------------------------------------------------------------------
228  ! The data io refers to task_t%iit(:) and task_t%t(:), and either all of
229  ! these places need to be protected wuth omp atomic read, or (simpler) the
230  ! occasional visit here to do I/O need to block other accesses (mainly in
231  ! download_mod) vi the task lock. Certain types of output (but not for
232  ! example legacy_io) may need to be protected by critical regions or a lock
233  ! on data_io), but (FIXME) for now this is neglected.
234  !-------------------------------------------------------------------------
235  if (io%verbose > 1) &
236  write (io%output,*) wallclock(),' thread',omp%thread,' locked output'
237  do while (patch%t(it) >= patch%out_next)
238  if (created < patch%iout) then
239  created = patch%iout
240  call os%mkdir (trim(io%outputname))
241  end if
242  call os%mkdir_no (patch%iout)
243  !-----------------------------------------------------------------------
244  count = self%counters%decrement (patch%iout+1, io%nwrite)
245  if (io%verbose > 0) &
246  write (io_unit%log,*) 'count, nwrite =', count, io%nwrite
247  append = (count < io%nwrite-1)
248  !-----------------------------------------------------------------------
249 !write (io_unit%log,'(a,f12.6,2i6,f10.6,2i6,l4)') &
250 !'io_data_t%output: clk, thread, id, time, count, nwrite, append =', &
251 !wallclock(), omp%thread, patch%id, patch%time, count, io%nwrite, append
252  if (io%method=='direct') then
253  call direct_io%output (patch)
254  else if (io%method=='amr') then
255  call amr_io%output (patch, count)
256  else if (io%method=='legacy') then
257  call legacy_io%output (patch)
258  !call output_txt (patch, append)
259  else if (io%method=='buffered') then
260  call buffered_io%output (patch)
261  else if (io%method=='pan') then
262  if (io%format == 0) &
263  io%format = 6
264  call parallel_io%output (patch, count)
265  else if (io%method=='parallel') then
266  if (io%format == 0) &
267  io%format = 6
268  call parallel_io%output (patch, count)
269  else if (io%method=='snapshot') then
270  if (io%format == 0) &
271  io%format = 10
272  call parallel_io%output (patch, count)
273  else
274  call mpi%abort ('unknown io%method = '//io%method)
275  end if
276  !-----------------------------------------------------------------------
277  if (count==0 .and. .not.io_unit%do_validate) then
278  if (io%out_time > 0d0) then
279  prv = modulo(patch%it-2,patch%nt) + 1
280  write(io%output,'(1x,a,2x,a,i5.5,6x,a,f9.3,6x,a,1p,3g14.5)') &
281  trim(io%method)//'_io:output', &
282  'snapshot '//trim(io%outputname), patch%iout, &
283  'size(GB):', io%gb_out, &
284  'time:', patch%t(prv), patch%out_next, patch%time
285  else
286  write(io%output,'(1x,a,2x,a,i5.5,6x,a,f9.3,6x,a,1p,g14.5)') &
287  trim(io%method)//'_io:output', &
288  'snapshot '//trim(io%outputname), patch%iout, &
289  'size(GB):', io%gb_out, 'time:', patch%time
290  end if
291  end if
292  !-----------------------------------------------------------------------
293  ! Output aux file, and namelist file with metadata
294  !-----------------------------------------------------------------------
295  call patch%aux%output (patch%iout, patch%id)
296  call output_nml (patch, append)
297  !-----------------------------------------------------------------------
298  patch%iout = patch%iout+1
299  if (io%out_time==0.0) exit
300  patch%out_next = (floor(patch%time/io%out_time+1.0+1e-6))*io%out_time
301  !-----------------------------------------------------------------------
302  if (io%verbose > 1) &
303  write (io%output,'(a,i6,3f12.6,3i4)') &
304  'io_t%output: id, iout, time, out_next, count =', &
305  patch%id, patch%time, patch%time-patch%dtime, patch%out_next, &
306  patch%iout, io%nwrite, count
307  !-----------------------------------------------------------------------
308  call os%mkdir_no (patch%iout)
309  end do
310  if (io%verbose > 1) &
311  write (io%output,*) wallclock(),' thread',omp%thread,' unlocked output'
312  call self%lock%unset ('output2')
313  end if
314  end if ! (io%needs_check)
315  call trace%end (itimer)
316 END SUBROUTINE output
317 
318 !===============================================================================
319 SUBROUTINE open_and_close (self)
320  class(data_io_t):: self
321  !-----------------------------------------------------------------------------
322  call trace%begin ('data_io_t%open_and_close')
323  if (io%method == 'snapshot') then
324  call parallel_io%open_and_close ()
325  else if (io%method == 'amr') then
326  if (io%halt) then
327  call self%lock%set ('halt')
328  call self%lock%unset ('halt')
329  end if
330  end if
331  call trace%end ()
332 END SUBROUTINE open_and_close
333 
334 !===============================================================================
335 !> Read snapshot from disk
336 !===============================================================================
337 SUBROUTINE input (self, patch, ok)
338  class(data_io_t):: self
339  class(patch_t):: patch
340  logical:: ok
341  integer:: count
342  !-----------------------------------------------------------------------------
343  call trace%begin ('data_io_t%input')
344  ok = .false.
345  if (io%restart >= 0) then
346  !$omp critical (data_io_input_cr)
347  if (io%method=='direct') then
348  call direct_io%input (patch, ok)
349  else if (io%method=='legacy') then
350  call input_nml (patch)
351  call legacy_io%input (patch, ok)
352  else if (io%method=='pan') then
353  call input_nml (patch)
354  call parallel_io%input (patch, ok)
355  else if (io%method=='parallel') then
356  call input_nml (patch)
357  call parallel_io%input (patch, ok)
358  else if (io%method=='snapshot') then
359  call input_nml (patch)
360  call parallel_io%input (patch, ok)
361  else
362  call mpi%abort ('unknown io%method = '//io%method)
363  end if
364  if (ok) then
365  count = self%counters%decrement (io%restart+1, io%nwrite)
366  if (count==0 .and. io%master) then
367  write(io%output,'(1x,a,2x,a,i5.5,5x,"time:",1p,g14.5)') &
368  trim(io%method)//'_io:input', &
369  'snapshot '//trim(io%outputname), io%restart, patch%time
370  end if
371  patch%t(patch%it) = patch%time
372  end if
373  !$omp end critical (data_io_input_cr)
374  end if
375  call trace%end()
376 END SUBROUTINE input
377 
378 !===============================================================================
379 !> Output text with patch info, either to individual files (io%format=1,2) or
380 !> to one file per rank (io%format>2). This is not threadsafe, both because of
381 !> the text file I/O, and because snapshot%ibuf is consantly being modified by
382 !> other threads (must be protected by the same critical region!).
383 !===============================================================================
384 SUBROUTINE output_txt (patch, append)
385  class(patch_t):: patch
386  logical:: append
387  !.............................................................................
388  real(8):: time
389  integer:: l(3), u(3)
390  character(len=128) filename
391  integer:: nlines=6
392  !-----------------------------------------------------------------------------
393  ! Write a small text file with info
394  !-----------------------------------------------------------------------------
395  call trace%begin ('data_io_t%output_txt')
396  !$omp critical (output_cr)
397  l = merge(patch%mesh%lb,patch%mesh%li,io%guard_zones)
398  u = merge(patch%mesh%ub,patch%mesh%ui,io%guard_zones)
399  if (io%format > 2) then
400  write (filename,'(a,i5.5,"/rank_",i5.5,".txt")') trim(io%outputname), patch%iout, mpi%rank
401  else
402  write (filename,'(a,i5.5,"/",i5.5,".info")') trim(io%outputname), patch%iout, patch%id
403  end if
404  if (io%debug(2)) &
405  write(io%output,'(a,3x,"time:",2f13.6)') &
406  ' data_io_t%output_txt: '//trim(filename), patch%out_next, patch%time
407  !-----------------------------------------------------------------------------
408  ! Open the file, appending or not
409  !-----------------------------------------------------------------------------
410  open (io_unit%data, file=trim(filename), form='formatted', status='unknown', &
411  access=trim(merge('append ','sequential',append)))
412  write (io_unit%data,'(i2.2)') io%format
413  if (io%format==3 .or. io%format==4) write (io_unit%data,*) patch%id, nlines
414  !-----------------------------------------------------------------------------
415  ! Write the text info
416  !-----------------------------------------------------------------------------
417  write (io_unit%data,'(a)') trim(patch%kind)
418  write (io_unit%data,'(a)') trim(patch%eos)
419  write (io_unit%data,'(a)') trim(patch%opacity)
420  write (io_unit%data,'(1p,2e18.10,6(2x,3e18.10)1x,1x,2e10.3)') patch%out_next, &
421  patch%dtime, patch%position, patch%ds, patch%velocity, patch%llc_nat, &
422  patch%llc_cart, patch%mesh%centre_nat, patch%quality, patch%gamma
423  write (io_unit%data,'(6(3i10.1,2x),3i2.1,1x,1i2.1,i3)') int(patch%box/patch%ds+0.5), &
424  u-l+1, patch%li, patch%ui, patch%n, patch%gn, patch%ng, patch%nv, patch%level
425  write (io_unit%data,'(3(1i8.1,1x),i2.1)') patch%id, patch%iout, patch%istep, patch%mesh_type
426  close (io_unit%data)
427  !$omp end critical (output_cr)
428  call trace%end()
429 END SUBROUTINE output_txt
430 
431 !===============================================================================
432 !> Output text with patch info, either to individual files (io%format=1,2) or
433 !> to one file per rank (io%format>2). This is not threadsafe, both because of
434 !> the text file I/O, and because snapshot%ibuf is consantly being modified by
435 !> other threads (must be protected by the same critical region!).
436 !===============================================================================
437 SUBROUTINE output_nml (patch, append)
438  class(patch_t):: patch
439  logical :: append
440  !.............................................................................
441  if (io%nml_version == 1) then
442  call output_nml_v1(patch, append)
443  else if (io%nml_version == 2) then
444  call output_nml_v2(patch, append)
445  else if (io%nml_version == 3) then
446  call output_nml_v3(patch, append)
447  else
448  print*,io%nml_version
449  call mpi%abort ('unknown nml_version!')
450  end if
451 CONTAINS
452 
453 SUBROUTINE output_nml_v1 (patch, append)
454  class(patch_t):: patch
455  logical :: append
456  !.............................................................................
457  character(len=128) :: filename
458  character(len=128), save:: filename1='', filename2=''
459  integer :: ioformat, id, iout, istep, mesh_type, level,nv, nt, &
460  nw, ntotal, format
461  integer, dimension(3):: ncell, li, ui, n, ng, gn, l, u
462  real :: gamma, quality
463  real(8) :: time, dtime, out_next, out_time, ms
464  real(8), dimension(3):: size, position, ds, box, velocity, &
465  llc_nat, llc_cart, centre_nat
466  integer :: time_derivs
467  logical :: guard_zones, no_mans_land, periodic(3)
468  integer, save :: last_snapshot=-1
469  character(len=16) :: kind, eos, opacity, method
470  namelist /io_nml/ format, ntotal, out_time, guard_zones, time_derivs, method
471  namelist /snapshot_nml/ ioformat, iout, time, ntotal, istep, mesh_type, &
472  position, size, ds, box, velocity, level, quality, gamma, ncell, li, ui, n, &
473  ng, gn, nv, nt, nw, kind, eos, opacity, periodic, guard_zones, time_derivs, &
474  no_mans_land
475  namelist /patch_nml/ id, time, position, size, level, dtime
476  !-----------------------------------------------------------------------------
477  ! Write a small text file with info
478  !-----------------------------------------------------------------------------
479  call trace%begin ('data_io_t%output_nml')
480  !-----------------------------------------------------------------------------
481  ! Write snapshot_nml to the file "data/run/NNNNN/snapshot.nml"
482  !-----------------------------------------------------------------------------
483  format = io%format
484  ioformat = io%format
485  ntotal = io%ntotal
486  out_time = io%out_time
487  guard_zones = io%guard_zones
488  time_derivs = io%time_derivs
489  method = io%method
490  iout = patch%iout
491  time = merge(patch%time, patch%out_next, io%out_time==0)
492  dtime = patch%dtime
493  l = merge(patch%mesh%lb,patch%mesh%li,io%guard_zones)
494  u = merge(patch%mesh%ub,patch%mesh%ui,io%guard_zones)
495  ncell = u-l+1
496  ! Special consideration for ZEUS solvers because the include one extra cell
497  ! for staggered quantities (all other variables should be zero in the extra
498  ! cell).
499  if (patch%kind(1:4) == 'zeus') then
500  where (patch%n > 1)
501  ncell = ncell + 1
502  end where
503  endif
504  id = patch%id
505  istep = patch%istep
506  mesh_type = patch%mesh_type
507  position = patch%position
508  size = patch%size
509  ds = patch%ds
510  box = patch%box
511  velocity = patch%velocity
512  level = patch%level
513  quality = patch%quality
514  gamma = patch%gamma
515  li = patch%li
516  ui = patch%ui
517  n = patch%n
518  gn = patch%gn
519  ng = patch%ng
520  nv = patch%nv
521  nv = merge(io%nv, patch%nv, io%nv>0 .and. io%nv<patch%nv)
522  nv = nv*(io%time_derivs+1)
523  nt = patch%nt
524  nw = patch%nw
525  kind = patch%kind
526  eos = patch%eos
527  opacity = patch%opacity
528  no_mans_land = patch%no_mans_land
529  periodic = patch%periodic
530  if (mpi%master .and. patch%iout > last_snapshot) then
531  last_snapshot = patch%iout
532  write (filename,'(a,i5.5,"/snapshot.nml")') trim(io%outputname), patch%iout
533  if (filename /= filename1) then
534  write(io_unit%log,'(a,i5,2x,2a)') &
535  ' thread', omp%thread, 'opening ', trim(filename)
536  flush (io_unit%log)
537  open (io_unit%nml1, file=trim(filename), form='formatted', status='unknown')
538  write(io_unit%log,'(a,i5,2x,2a)') &
539  ' thread', omp%thread, 'opened ', trim(filename)
540  flush (io_unit%log)
541  filename1 = filename
542  end if
543  write (io_unit%nml1, io_nml)
544  write (io_unit%nml1, snapshot_nml)
545  call patch%idx%output (io_unit%nml1)
546  call file_append (io_unit%nml, io_unit%nml1)
547  flush (io_unit%nml1)
548  if (io%debug(2)) write(io%output,'(a,3x,"time:",2f13.6)') &
549  ' data_io_t%output_nml: '//trim(filename), patch%out_next, patch%time
550  end if
551  !-----------------------------------------------------------------------------
552  ! Open the file "data/run/rank_rrrrr_patches.nml", appending or not
553  !-----------------------------------------------------------------------------
554  write (filename,'(a,i5.5,"/rank_",i5.5,"_patches.nml")') &
555  trim(io%outputname), patch%iout, mpi%rank
556  if (filename /= filename2) then
557  if (filename2 /= '') close (io_unit%nml2)
558  write(io_unit%log,'(a,i5,2x,2a)') &
559  ' thread', omp%thread, 'opening ', trim(filename)
560  flush (io_unit%log)
561  open (io_unit%nml2, file=trim(filename), form='formatted', status='unknown', &
562  access=trim(merge('append ','sequential',append)))
563  write(io_unit%log,'(a,i5,2x,2a)') &
564  ' thread', omp%thread, 'opened ', trim(filename)
565  flush (io_unit%log)
566  filename2 = filename
567  end if
568  !-----------------------------------------------------------------------------
569  ! Write the namelist info, including a leading idx_nml
570  !-----------------------------------------------------------------------------
571  if (mpi%master .and. .not.append) then
572  call patch%idx%output (io_unit%nml2)
573  end if
574  write (io_unit%nml2, patch_nml)
575  flush (io_unit%nml2)
576  call trace%end()
577 END SUBROUTINE output_nml_v1
578 
579 SUBROUTINE output_nml_v2 (patch, append)
580  class(patch_t):: patch
581  logical :: append
582  !.............................................................................
583  character(len=128) :: filename
584  character(len=128), save:: filename1='', filename2=''
585  integer :: ioformat, id, iout, istep, mesh_type, level,nv, nt, &
586  nw, ntotal, format, nml_version
587  integer, dimension(3):: ncell, li, ui, n, ng, gn, l, u
588  real :: gamma, quality
589  real(8) :: time, dtime, out_next, out_time, ms
590  real(8), dimension(3):: size, position, ds, box, velocity, &
591  llc_nat, llc_cart, centre_nat
592  integer :: time_derivs
593  logical :: guard_zones, no_mans_land, periodic(3)
594  integer, save :: last_snapshot=-1
595  character(len=32) :: kind, eos, opacity, method
596  namelist /io_nml/ format, ntotal, out_time, guard_zones, time_derivs, method, nml_version
597  namelist /snapshot_nml/ ioformat, iout, time, ntotal, box, li, ui, ng, gn, &
598  nv, nt, gamma, eos, opacity, periodic, guard_zones, time_derivs, no_mans_land
599  namelist /patch_nml/ id, position, size, level, dtime, istep, ds, ncell, n, nw, &
600  velocity, quality, mesh_type, kind
601  !-----------------------------------------------------------------------------
602  ! Write a small text file with info
603  !-----------------------------------------------------------------------------
604  call trace%begin ('data_io_t%output_nml')
605  !-----------------------------------------------------------------------------
606  ! Write snapshot_nml to the file "data/run/NNNNN/snapshot.nml"
607  !-----------------------------------------------------------------------------
608  format = io%format
609  ioformat = io%format
610  nml_version = io%nml_version
611  ntotal = io%ntotal
612  out_time = io%out_time
613  guard_zones = io%guard_zones
614  time_derivs = io%time_derivs
615  method = io%method
616  iout = patch%iout
617  time = merge(patch%time, patch%out_next, io%out_time==0)
618  dtime = patch%dtime
619  istep = patch%istep
620  l = merge(patch%mesh%lb,patch%mesh%li,io%guard_zones)
621  u = merge(patch%mesh%ub,patch%mesh%ui,io%guard_zones)
622  ncell = u-l+1
623  ! Special consideration for ZEUS solvers because the include one extra cell
624  ! for staggered quantities (all other variables should be zero in the extra
625  ! cell).
626  if (patch%kind(1:4) == 'zeus') then
627  where (patch%n > 1)
628  ncell = ncell + 1
629  end where
630  endif
631  id = patch%id
632  istep = patch%istep
633  mesh_type = patch%mesh_type
634  position = patch%position
635  size = patch%size
636  ds = patch%ds
637  box = patch%box
638  velocity = patch%velocity
639  level = patch%level
640  quality = patch%quality
641  gamma = patch%gamma
642  li = patch%li
643  ui = patch%ui
644  n = patch%n
645  gn = patch%gn
646  ng = patch%ng
647  nv = patch%nv
648  nv = merge(io%nv, patch%nv, io%nv>0 .and. io%nv<patch%nv)
649  nv = nv*(io%time_derivs+1)
650  nt = patch%nt
651  nw = patch%nw
652  kind = patch%kind
653  eos = patch%eos
654  opacity = patch%opacity
655  no_mans_land = patch%no_mans_land
656  periodic = patch%periodic
657  if (mpi%master .and. patch%iout > last_snapshot) then
658  last_snapshot = patch%iout
659  write (filename,'(a,i5.5,"/snapshot.nml")') trim(io%outputname), patch%iout
660  if (filename /= filename1) then
661  write(io_unit%log,'(a,i5,2x,2a)') &
662  ' thread', omp%thread, 'opening ', trim(filename)
663  flush (io_unit%log)
664  open (io_unit%nml1, file=trim(filename), form='formatted', status='unknown')
665  write(io_unit%log,'(a,i5,2x,2a)') &
666  ' thread', omp%thread, 'opened ', trim(filename)
667  flush (io_unit%log)
668  filename1 = filename
669  end if
670  write (io_unit%nml1, io_nml)
671  write (io_unit%nml1, snapshot_nml)
672  call patch%idx%output (io_unit%nml1)
673  call file_append (io_unit%nml, io_unit%nml1)
674  flush (io_unit%nml1)
675  if (io%debug(2)) write(io%output,'(a,3x,"time:",2f13.6)') &
676  ' data_io_t%output_nml: '//trim(filename), patch%out_next, patch%time
677  end if
678  !-----------------------------------------------------------------------------
679  ! Open the file "data/run/rank_rrrrr_patches.nml", appending or not
680  !-----------------------------------------------------------------------------
681  write (filename,'(a,i5.5,"/rank_",i5.5,"_patches.nml")') &
682  trim(io%outputname), patch%iout, mpi%rank
683  if (filename /= filename2) then
684  if (filename2 /= '') close (io_unit%nml2)
685  write(io_unit%log,'(a,i5,2x,2a)') &
686  ' thread', omp%thread, 'opening ', trim(filename)
687  flush (io_unit%log)
688  open (io_unit%nml2, file=trim(filename), form='formatted', status='unknown', &
689  access=trim(merge('append ','sequential',append)))
690  write(io_unit%log,'(a,i5,2x,2a)') &
691  ' thread', omp%thread, 'opened ', trim(filename)
692  flush (io_unit%log)
693  filename2 = filename
694  end if
695  !-----------------------------------------------------------------------------
696  ! Write the namelist info, including a leading idx_nml
697  !-----------------------------------------------------------------------------
698  if (mpi%master .and. .not.append) then
699  call patch%idx%output (io_unit%nml2)
700  end if
701  write (io_unit%nml2, patch_nml)
702  flush (io_unit%nml2)
703  call trace%end()
704 END SUBROUTINE output_nml_v2
705 
706 SUBROUTINE output_nml_v3 (patch, append)
707  class(patch_t):: patch
708  logical :: append
709  !.............................................................................
710  character(len=128) :: filename
711  character(len=128), save:: filename1='', filename2=''
712  integer :: ioformat, id, iout, istep, mesh_type, level,nv, nt, &
713  nw, ntotal, format
714  integer, dimension(3):: ncell, li, ui, n, ng, gn, l, u
715  real :: gamma, quality
716  real(8) :: time, dtime, out_next, out_time, ms
717  real(8) :: times(2), dtimes(2)
718  real(8), dimension(3):: size, position, ds, box, velocity, &
719  llc_nat, llc_cart, centre_nat
720  integer :: time_derivs, now, prv
721  integer(8) :: task_offset
722  logical :: guard_zones, no_mans_land, periodic(3)
723  integer, save :: last_snapshot=-1
724  character(len=16) :: kind, eos, opacity, method
725  namelist /io_nml/ format, ntotal, out_time, guard_zones, time_derivs, method
726  namelist /snapshot_nml/ ioformat, iout, time, ntotal, istep, mesh_type, &
727  position, size, ds, box, velocity, level, quality, gamma, ncell, li, ui, n, &
728  ng, gn, nv, nt, nw, kind, eos, opacity, periodic, guard_zones, time_derivs, &
729  no_mans_land
730  namelist /patch_nml/ id, time, position, size, level, dtime, times, dtimes, &
731  task_offset
732  !-----------------------------------------------------------------------------
733  ! Write a small text file with info
734  !-----------------------------------------------------------------------------
735  call trace%begin ('data_io_t%output_nml')
736  !-----------------------------------------------------------------------------
737  ! Write snapshot_nml to the file "data/run/NNNNN/snapshot.nml"
738  !-----------------------------------------------------------------------------
739  format = io%format
740  ioformat = io%format
741  ntotal = io%ntotal
742  out_time = io%out_time
743  guard_zones = io%guard_zones
744  time_derivs = io%time_derivs
745  method = io%method
746  iout = patch%iout
747  time = merge(patch%time, patch%out_next, io%out_time==0)
748  dtime = patch%dtime
749  now = patch%it
750  task_offset = patch%amr_offset
751  if (patch%istep > 1) then
752  prv = modulo(now-2,patch%nt) + 1
753  else
754  prv = now
755  end if
756  times(1) = patch%t (prv)
757  times(2) = patch%t (now)
758  dtimes(1) = patch%dt(prv)
759  dtimes(2) = patch%dt(now)
760  l = merge(patch%mesh%lb,patch%mesh%li,io%guard_zones)
761  u = merge(patch%mesh%ub,patch%mesh%ui,io%guard_zones)
762  ncell = u-l+1
763  ! Special consideration for ZEUS solvers because the include one extra cell
764  ! for staggered quantities (all other variables should be zero in the extra
765  ! cell).
766  if (patch%kind(1:4) == 'zeus') then
767  where (patch%n > 1)
768  ncell = ncell + 1
769  end where
770  endif
771  id = patch%id
772  istep = patch%istep
773  mesh_type = patch%mesh_type
774  position = patch%position
775  size = patch%size
776  ds = patch%ds
777  box = patch%box
778  velocity = patch%velocity
779  level = patch%level
780  quality = patch%quality
781  gamma = patch%gamma
782  li = patch%li
783  ui = patch%ui
784  n = patch%n
785  gn = patch%gn
786  ng = patch%ng
787  nv = patch%nv
788  nv = merge(io%nv, patch%nv, io%nv>0 .and. io%nv<patch%nv)
789  nv = nv*(io%time_derivs+1)
790  nt = patch%nt
791  nw = patch%nw
792  kind = patch%kind
793  eos = patch%eos
794  opacity = patch%opacity
795  no_mans_land = patch%no_mans_land
796  periodic = patch%periodic
797  if (mpi%master .and. patch%iout > last_snapshot) then
798  last_snapshot = patch%iout
799  write (filename,'(a,i5.5,"/snapshot.nml")') trim(io%outputname), patch%iout
800  if (filename /= filename1) then
801  write(io_unit%log,'(a,i5,2x,2a)') &
802  ' thread', omp%thread, 'opening ', trim(filename)
803  flush (io_unit%log)
804  open (io_unit%nml1, file=trim(filename), form='formatted', status='unknown')
805  write(io_unit%log,'(a,i5,2x,2a)') &
806  ' thread', omp%thread, 'opened ', trim(filename)
807  flush (io_unit%log)
808  filename1 = filename
809  end if
810  write (io_unit%nml1, io_nml)
811  write (io_unit%nml1, snapshot_nml)
812  call patch%idx%output (io_unit%nml1)
813  call file_append (io_unit%nml, io_unit%nml1)
814  flush (io_unit%nml1)
815  if (io%debug(2)) write(io%output,'(a,3x,"time:",2f13.6)') &
816  ' data_io_t%output_nml: '//trim(filename), patch%out_next, patch%time
817  end if
818  !-----------------------------------------------------------------------------
819  ! Open the file "data/run/rank_rrrrr_patches.nml", appending or not
820  !-----------------------------------------------------------------------------
821  write (filename,'(a,i5.5,"/rank_",i5.5,"_patches.nml")') &
822  trim(io%outputname), patch%iout, mpi%rank
823  if (filename /= filename2) then
824  if (filename2 /= '') close (io_unit%nml2)
825  write(io_unit%log,'(a,i5,2x,2a)') &
826  ' thread', omp%thread, 'opening ', trim(filename)
827  flush (io_unit%log)
828  open (io_unit%nml2, file=trim(filename), form='formatted', status='unknown', &
829  access=trim(merge('append ','sequential',append)))
830  write(io_unit%log,'(a,i5,2x,2a)') &
831  ' thread', omp%thread, 'opened ', trim(filename)
832  flush (io_unit%log)
833  filename2 = filename
834  end if
835  !-----------------------------------------------------------------------------
836  ! Write the namelist info, including a leading idx_nml
837  !-----------------------------------------------------------------------------
838  if (mpi%master .and. .not.append) then
839  call patch%idx%output (io_unit%nml2)
840  end if
841  write (io_unit%nml2, patch_nml)
842  flush (io_unit%nml2)
843  call trace%end()
844 END SUBROUTINE output_nml_v3
845 
846 END SUBROUTINE output_nml
847 
848 !===============================================================================
849 !> Read in the basic, common meta-data from the snapshot.nml file.
850 !===============================================================================
851 SUBROUTINE input_nml (patch)
852  class(patch_t):: patch
853  !.............................................................................
854  if (io%nml_version == 1) then
855  call input_nml_v1(patch)
856  else if (io%nml_version == 2) then
857  call input_nml_v2(patch)
858  else
859  print*,io%nml_version
860  call mpi%abort ('unknown nml_version!')
861  end if
862 
863 CONTAINS
864 !===============================================================================
865 !> Read snapshot namelists, version 1.
866 !===============================================================================
867 SUBROUTINE input_nml_v1 (patch)
868  class(patch_t):: patch
869  !.............................................................................
870  character(len=128) :: filename
871  character(len=128), save:: filename1='', filename2=''
872  integer, save :: ioformat, id, iout, istep, mesh_type, level,nv, nt, &
873  nw, ntotal, format
874  integer, dimension(3):: ncell, li, ui, n, ng, gn, l, u
875  real , save :: gamma, quality
876  real(8), save :: time, dtime, out_next, out_time, ms
877  real(8), dimension(3):: size, position, ds, box, velocity, &
878  llc_nat, llc_cart, centre_nat
879  integer, save :: time_derivs
880  logical, save :: guard_zones, no_mans_land, periodic(3)
881  character(len=16) :: kind, eos, opacity, method
882  integer :: iostat
883  namelist /snapshot_nml/ ioformat, iout, time, ntotal, istep, mesh_type, &
884  position, size, ds, box, velocity, level, quality, gamma, ncell, li, ui, n, &
885  ng, gn, nv, nt, nw, kind, eos, opacity, periodic, guard_zones, time_derivs, &
886  no_mans_land
887  !-----------------------------------------------------------------------------
888  real(8), save :: origin(3)
889  integer, save :: dims(3), mpi_dims(3), per_rank(3)
890  logical, save :: face_nbors, fast_nbors, omp_init
891  namelist /cartesian_params/ size, dims, mpi_dims, per_rank, origin, face_nbors, &
892  fast_nbors, omp_init
893  logical, save:: first_time=.true.
894  !-----------------------------------------------------------------------------
895  ! Read info from namelist
896  !-----------------------------------------------------------------------------
897  call trace%begin ('data_io_t%input_nml')
898  !$omp critical (output_cr)
899  if (first_time) then
900  first_time = .false.
901  patch%iout = io%restart
902  write (filename,'(a,i5.5,"/snapshot.nml")') trim(io%inputdir), patch%iout
903  open (unit=io_unit%nml1, file=filename, form='formatted', status='old')
904  read (io_unit%nml1, snapshot_nml, iostat=iostat)
905  read (io_unit%nml1, cartesian_params, iostat=iostat)
906  close (io_unit%nml1)
907  io%mpi_odims = mpi_dims
908  end if
909  patch%t = time
910  patch%dt = 0d0
911  patch%time = time
912  patch%istep = 0
913  patch%out_next = (floor(patch%time/io%out_time+1.0+1e-6))*io%out_time
914  patch%guard_zones = guard_zones
915  patch%time_derivs = time_derivs
916  !$omp end critical (output_cr)
917  call trace%end()
918 END SUBROUTINE input_nml_v1
919 
920 END SUBROUTINE input_nml
921 
922 !===============================================================================
923 !> Read snapshot namelists, version 2.
924 !===============================================================================
925 SUBROUTINE input_nml_v2 (patch)
926  class(patch_t):: patch
927  !.............................................................................
928  character(len=128) :: filename
929  character(len=128), save:: filename1='', filename2=''
930  integer, save :: ioformat, id, iout, istep, mesh_type, level,nv, nt, &
931  nw, ntotal, format
932  integer, dimension(3):: ncell, li, ui, n, ng, gn, l, u
933  real , save :: gamma, quality
934  real(8), save :: time, dtime, out_next, out_time, ms
935  real(8), dimension(3):: size, position, ds, box, velocity, &
936  llc_nat, llc_cart, centre_nat
937  integer, save :: time_derivs
938  logical, save :: guard_zones, no_mans_land, periodic(3)
939  character(len=32) :: kind, eos, opacity, method
940  integer :: iostat
941  namelist /snapshot_nml/ ioformat, iout, time, ntotal, box, li, ui, ng, gn, &
942  nv, nt, gamma, eos, opacity, periodic, guard_zones, time_derivs, no_mans_land
943  !-----------------------------------------------------------------------------
944  real(8), save :: origin(3)
945  integer, save :: dims(3), mpi_dims(3), per_rank(3)
946  logical, save :: face_nbors, fast_nbors, omp_init
947  namelist /cartesian_params/ size, dims, mpi_dims, per_rank, origin, face_nbors, &
948  fast_nbors, omp_init
949  namelist /patch_nml/ id, position, size, level, dtime, istep, ds, ncell, n, nw, &
950  velocity, quality, mesh_type, kind
951  logical, save:: first_time=.true.
952  !-----------------------------------------------------------------------------
953  ! Read info from namelist
954  !-----------------------------------------------------------------------------
955  call trace%begin ('data_io_t%input_nml')
956  !$omp critical (output_cr)
957  patch%iout = io%restart
958  if (first_time) then
959  first_time = .false.
960  write (filename,'(a,i5.5,"/snapshot.nml")') trim(io%inputdir), patch%iout
961  open (unit=io_unit%nml1, file=filename, form='formatted', status='old')
962  read (io_unit%nml1, snapshot_nml, iostat=iostat)
963  read (io_unit%nml1, cartesian_params, iostat=iostat)
964  close (io_unit%nml1)
965  io%mpi_odims = mpi_dims
966  io%format = ioformat
967  io%ntotal = ntotal
968  io%time_derivs = time_derivs
969  io%guard_zones = guard_zones
970  end if
971  patch%time = time
972  patch%t = time
973  patch%guard_zones = guard_zones
974  patch%time_derivs = time_derivs
975  !-----------------------------------------------------------------------------
976  ! Open the file "data/run/rank_rrrrr_patches.nml" for reading
977  !-----------------------------------------------------------------------------
978  write (filename,'(a,i5.5,"/rank_",i5.5,"_patches.nml")') &
979  trim(io%inputdir), patch%iout, mpi%rank
980  if (filename /= filename2) then
981  if (filename2 /= '') close (io_unit%nml2)
982  open (io_unit%nml2, file=trim(filename), form='formatted', status='old')
983  filename2 = filename
984  end if
985  rewind(io_unit%nml2)
986  do
987  read (io_unit%nml2, patch_nml, iostat=iostat)
988  if (id == patch%id) exit
989  if (iostat < 0) then
990  print*,'ID = ',patch%id
991  call mpi%abort('input_nml: patch_nml not found! Abort!')
992  end if
993  end do
994  patch%dt = dtime
995  patch%dtime = dtime
996  patch%istep = istep
997  patch%out_next = (floor(patch%time/io%out_time+1.0+1e-6))*io%out_time
998  patch%velocity = velocity
999  !$omp end critical (output_cr)
1000  call trace%end()
1001 END SUBROUTINE input_nml_v2
1002 
1003 !===============================================================================
1004 !> Copy one text file to another
1005 !===============================================================================
1006 SUBROUTINE file_append (unit1, unit2)
1007  integer:: unit1, unit2
1008  character(len=128):: line
1009  integer:: iostat
1010  !-----------------------------------------------------------------------------
1011  rewind(unit1)
1012  do while (.true.)
1013  read (unit1,'(a)',iostat=iostat) line
1014  if (iostat /= 0) exit
1015  write (unit2,'(a)') trim(line)
1016  end do
1017 END SUBROUTINE file_append
1018 
1019 !===============================================================================
1020 !> Close the data I/O
1021 !===============================================================================
1022 SUBROUTINE close()
1023  !.............................................................................
1024  if (.not.io%do_output) return
1025  call trace%begin('patch_t%close')
1026  if (io%method=='legacy') then
1027  !call legacy_io%close()
1028  else if (io%method=='direct') then
1029  call direct_io%close()
1030  else if (io%method=='buffered') then
1031  call buffered_io%close()
1032  else if (io%method=='pan') then
1033  call parallel_io%close()
1034  else if (io%method=='parallel') then
1035  call parallel_io%close()
1036  else if (io%method=='snapshot') then
1037  call parallel_io%close()
1038  end if
1039  call trace%end()
1040 END SUBROUTINE close
1041 
1042 END MODULE data_io_mod
Compute time derivative from a sequence of time slices, using Lagrange interpolation.
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Interface from gpatch_mod to a choice of binary data I/O methods, controlled by the iomethod text str...
Definition: data_io_mod.f90:17
Use MPI parallel I/O to write everything to a single file. No critical regions should be needed here;...
Help keep track of when all patches have passed some counter, by decrementing a counter, from start to 0. Typical use:
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
Definition: patch_mod.f90:6
Module to periodically output a density probability density function (PDF). The procedure assumes tha...
Definition: pdf_io_mod.f90:5
Doubly linked list (DLL), carrying anything, as simply as possible.
Definition: dll_mod.f90:4
Module handling convenient AMR I/O. We wish to have a file format that makes it easy to read when res...
Definition: amr_io_mod.f90:47
This index file has slot indices for all solver, all initially equal to zero It is the responsibility...
Definition: index_mod.f90:7
Definition: io_mod.f90:4
The lock module uses nested locks, to allow versatile use of locks, where a procedure may want to mak...
Template module for tasks.
Definition: task_mod.f90:4