13 logical:: mpi_trace=.false.
15 integer:: verbose=0, input, output, data_unit
16 logical:: master=.true.
17 logical:: do_legacy, do_direct, omp_trace
18 character(len=16):: method=
'legacy' 23 integer:: nml_version=0
25 integer:: nwrite=0, ntask=0, ntotal=0
26 integer:: dims(3)=0, mpi_dims(3), mpi_odims(3)=1
27 character(len=64):: inputname, outputname, datadir=
'data', top
28 character(len=64):: rundir=
'data', inputdir=
'data' 29 character(len=1):: sep =
'/' 30 character(len=72):: hl=
'-------------------------------------------------------------------------' 31 character(len=72):: hs=
'*************************************************************************' 33 logical:: do_trace=.false.
34 logical:: do_output=.true.
35 logical:: do_debug=.false.
36 logical:: do_flags=.false.
37 logical:: do_stop=.false.
38 logical:: guard_zones=.false.
39 logical:: namelist_errors=.true.
40 logical:: needs_check=.false.
41 logical:: halt=.false.
42 integer:: task_logging=0
44 integer:: time_derivs=0
49 real(8):: end_time=1d30
50 real(8):: out_time=1d0
51 real(8):: out_next=1d0
52 real(8):: print_time=0d0
53 real(8):: print_next=0d0
54 real(8):: dtime=huge(1d0)
56 real(8):: job_seconds=1d30
57 real(8):: processing=0d0
70 procedure:: check_flags
74 procedure:: namelist_warning
75 procedure,
nopass:: abort
76 procedure,
nopass:: assert
77 procedure,
nopass:: header
78 procedure,
nopass:: print_hl
80 character(len=64),
save:: inputname, outputname
81 type(io_t),
public:: io
82 public mch, io_unit, stderr, stdout, stdin
88 LOGICAL FUNCTION debug (self, verbose)
91 debug = self%master .and. (self%verbose >= verbose)
100 SUBROUTINE init (self, name)
102 character(len=120),
save:: id = &
103 'io_mod.f90 $Id: 2dbf9184a65cf7224399bde7bb8ef20adde87879 $' 104 integer,
save:: verbose=0, levelmax=10
105 character(len=*),
optional:: name
106 character(len=64):: filename, datadir=
'data', inputdir=
'data' 107 character(len=64),
save:: top=
'../../' 108 character(len=8),
save:: method=
'legacy' 109 integer,
save:: id_debug=-1, restart=-9, format=0, time_derivs=0, nml_version=1
110 integer,
save:: log_sent=0, task_logging=0
111 logical,
save:: first_time=.true., omp_trace=.false., do_validate=.false.
112 logical,
save:: do_debug=.false., do_trace=.false., do_output=.false., exist, &
113 do_legacy=.false., do_flags=.false., do_direct=.false., guard_zones=.false.
114 logical ,
save:: namelist_errors=.true.
115 namelist /io_params/ verbose, do_debug, do_trace, do_output, do_flags, &
116 do_validate, do_legacy, do_direct, levelmax, omp_trace, id_debug, top, &
117 datadir, inputdir, method, restart,
format, guard_zones, time_derivs, log_sent, &
118 task_logging, namelist_errors, nml_version
121 character(len=120):: ids = &
122 '$Id: 2dbf9184a65cf7224399bde7bb8ef20adde87879 $ io/io_mod.f90' 126 print
'(a)', trim(ids)
128 self%master = mpi%master
129 io%master = mpi%master
136 self%input = io_unit%input
144 call getarg(1,filename)
145 if (filename/=
' '.and.trim(filename)/=
'input.nml')
then 146 self%inputname = filename
147 self%rundir = trim(datadir)//self%sep// &
148 trim(filename(1:index(filename,
'.')-1))//self%sep
150 self%inputname =
'input.nml' 151 self%rundir = trim(datadir)//self%sep
153 call os%mkdir (trim(self%rundir))
154 self%outputname = self%rundir
155 write (filename,
'(a,i5.5,"/")') trim(self%outputname), 0
156 call os%mkdir (trim(filename))
158 open (io_unit%nml, file=trim(self%rundir)//
'params.nml', form=
'formatted', status=
'unknown')
159 open (io_unit%hash, file=trim(self%rundir)//
'hash.log', form=
'formatted', status=
'unknown')
160 open (self%input, file=self%inputname, form=
'formatted', status=
'old')
164 inputdir = self%rundir
165 rewind(io_unit%input)
166 read (io_unit%input, io_params, iostat=iostat)
167 if (iostat > 0)
call self%namelist_warning (
'io_params')
168 if (mpi%master .and. .not. do_validate)
then 169 print
'(a,i4)',
' n_socket =', omp%nsockets
170 print
'(a,i4)',
' n_core =', omp%ncores
171 print
'(a,i4)',
' n_thread =', omp_nthreads
173 self%task_logging = task_logging
175 self%nml_version = nml_version
176 self%inputdir = inputdir
177 call ensure_dirname (self%inputdir)
178 call ensure_dirname (self%outputname)
185 io_unit%verbose = verbose
189 io_unit%rundir = self%rundir
190 io_unit%inputdir = self%inputdir
191 io_unit%outputname = self%outputname
192 io_unit%do_validate = do_validate
201 call open_rank_file (io_unit%queue ,
".nq" ,
'formatted')
202 call open_rank_file (io_unit%mpi ,
".log" ,
'formatted')
203 call open_rank_file (io_unit%task ,
".task" ,
'formatted')
204 call open_rank_file (io_unit%dbg ,
".dbg" ,
'unformatted')
205 call open_rank_file (io_unit%dump ,
".dump" ,
'unformatted')
206 call open_rank_file (io_unit%validate ,
".val" ,
'unformatted')
207 call open_rank_file (io_unit%dispatcher,
".disp" ,
'formatted')
212 if (omp_trace .and. omp%nthreads>1)
then 213 io_unit%log = 110 + omp%mythread()
214 call open_rank_file (io_unit%log ,
".log" ,
'formatted', omp%mythread())
216 io_unit%log = io_unit%mpi
221 if (mpi%rank > 0)
then 222 io_unit%output = io_unit%mpi
225 io_unit%master = io%master .and. omp%master
226 write (io_unit%log,
'(a,2i4,3l4)') &
227 'io_mod::init io_unit%log, omp%thread, io_unit%master, io_unit%verbose:', &
228 io_unit%log, omp%thread, io_unit%master, io_unit%verbose
233 stdout = io_unit%output
234 write (stdout,io_params)
238 io%output = io_unit%output
239 io%data_unit = io_unit%data
240 write(io%output,*)
'logfile:', filename
241 write(io%output,*)
'=======================================================================' 242 write(io%output,*)
'NOTE: Reading parameters from '//trim(self%inputname)
243 write(io%output,*)
' This version was compiled with default real KIND=', kind(test)
244 write(io%output,*)
'=======================================================================' 247 self%guard_zones = guard_zones
248 self%time_derivs = time_derivs
249 self%restart = restart
250 self%datadir = datadir
251 self%id_debug = id_debug
252 self%verbose = verbose
253 self%do_debug = do_debug
254 self%do_trace = do_trace
255 self%do_output = do_output
256 self%do_flags = do_flags
257 self%do_legacy = do_legacy
258 self%do_direct = do_direct
259 self%omp_trace = omp_trace
260 self%log_sent = log_sent
261 self%levelmax = levelmax
262 self%inputname = inputname
265 self%namelist_errors = namelist_errors
266 if (do_legacy) self%method =
'legacy' 267 if (do_direct) self%method =
'direct' 269 io_unit%do_validate = do_validate
270 stdout = io_unit%output
274 subroutine ensure_dirname (s)
278 if (s(l:l) /=
'/') s(l+1:l+1)=
'/' 280 subroutine open_rank_file (unit, ext, form, thread)
282 integer,
optional:: thread
283 character(len=*):: ext, form
284 character(len=64):: filename
286 if (
present(thread))
then 287 open (unit=unit, file=trim(filename), form=form, status=
'unknown')
288 write (io_unit%threadbase,
'(a,"thread_",i5.5,"_",i3.3)') &
289 trim(self%outputname), mpi%rank, thread
290 filename = trim(io_unit%threadbase)//ext
292 write (io_unit%rankbase,
'(a,"rank_",i5.5)') &
293 trim(self%outputname), mpi%rank
294 filename = trim(io_unit%rankbase)//ext
296 open (unit=unit, file=trim(filename), form=form, status=
'unknown')
303 SUBROUTINE bits_mem (self, bits, count, label)
305 integer:: bits, count
306 character(len=*),
optional:: label
308 if (io%verbose>2)
then 309 if (
present(label))
then 310 write(io%output,1) bits,
' bits per word', count,
' words, for', &
311 (bits/(8.*1024.**3))*count,
' GB '//trim(label)
312 1
format(i3,a,i8,a,f6.3,a)
314 write(io%output,1) bits,
' bits per word', count,
' words, for', &
315 (bits/(8.*1024.**3))*count,
' GB' 318 call self%gb_mem ((bits/(8.*1024.**3))*count)
319 END SUBROUTINE bits_mem
324 SUBROUTINE gb_mem (self, gb)
327 real,
save:: gb_next=1.0
331 self%gb = self%gb + gb
334 if (abs(lgb - gb_next) > 1.0)
then 336 if (abs(lgb - gb_next) > 1.0)
then 337 do while (abs(lgb - gb_next) > 1.0)
338 call self%gb_print(lgb)
339 gb_next = gb_next + sign(1.0,lgb - gb_next)
345 END SUBROUTINE gb_mem
350 SUBROUTINE gb_print (self, gb)
354 print
'(1x,a,f8.3,a)',
'process memory allocated:', gb,
' GB' 355 END SUBROUTINE gb_print
363 SUBROUTINE check_flags (self)
365 real(8),
save :: last_checked=0d0
368 character(len=80) :: file
369 integer,
save :: itimer=0
372 call timer%begin (
'io_t%check_flags', itimer)
373 flag_time = merge(self%flag_time, self%flag_max, self%do_flags)
377 if (io%processing==0d0)
then 378 if (wallclock() > last_checked+flag_time)
then 379 last_checked = wallclock()
380 call check_all (.false.)
385 else if (wallclock() > io%processing+10d0)
then 390 else if (wallclock() > io%processing+5d0)
then 391 if (io%master)
call check_all (.true.)
393 call timer%end (itimer)
400 subroutine check_all (remove)
404 file = trim(io%outputname)//
'flag' 405 inquire (file=trim(file), exist=exists)
410 io%processing = last_checked + flag_time
411 open (io_unit%flag, file=trim(file), form=
'formatted', status=
'old')
413 close (io_unit%flag, status=
'delete')
418 call check (
'do_trace.flag' , remove, lvalue=self%do_trace)
419 call check (
'do_flags.flag' , remove, lvalue=self%do_flags)
420 call check (
'do_debug.flag' , remove, lvalue=self%do_debug)
421 call check (
'do_output.flag' , remove, lvalue=self%do_output)
422 call check (
'stop.flag' , remove, lvalue=self%do_stop)
424 call check (
'id_debug.flag' , remove, ivalue=self%id_debug)
425 call check (
'id_track.flag' , remove, ivalue=self%id_track)
426 call check (
'verbose.flag' , remove, ivalue=self%verbose)
428 call check (
'flag_time.flag' , remove, rvalue=self%flag_time)
429 call check (
'flag_max.flag' , remove, rvalue=self%flag_max)
430 call check (
'ampl.flag' , remove, rvalue=self%ampl)
431 call check (
'grace.flag ' , remove, rvalue=self%grace)
432 call check (
'smallr.flag ' , remove, rvalue=self%smallr)
433 call check (
'courant.flag ' , remove, rvalue=self%courant)
435 call check (
'out_time.flag' , remove, dvalue=self%out_time)
436 call check (
'out_next.flag' , remove, dvalue=self%out_next)
437 call check (
'print_time.flag' , remove, dvalue=self%print_time)
438 call check (
'end_time.flag' , remove, dvalue=self%end_time)
439 call check (
'sec_per_report.flag' , remove, dvalue=timer%sec_per_report)
441 if (io%do_stop .and. mpi%master)
then 442 write (stdout,*) file
443 open (io_unit%flag, file=file, form=
'formatted', status=
'unknown')
444 close (io_unit%flag, status=
'delete')
445 call io%abort (
'stop.flag detected')
452 subroutine check (file, remove, lvalue, ivalue, rvalue, dvalue)
453 character(len=*) :: file
455 logical,
optional :: lvalue
456 integer,
optional :: ivalue
457 real ,
optional :: rvalue
458 real(8),
optional :: dvalue
461 character(len=80) :: f
463 f = trim(io%outputname)//trim(file)
465 inquire (file=trim(f), exist=exists)
467 open (io_unit%flag, file=trim(f), form=
'formatted', status=
'old', iostat=iostat)
468 close (io_unit%flag, status=
'delete')
471 inquire (file=trim(f), exist=exists)
473 open (io_unit%flag, file=trim(f), form=
'formatted', status=
'old', iostat=iostat)
474 if (
present(ivalue))
read (io_unit%flag,*) ivalue
475 if (
present(rvalue))
read (io_unit%flag,*) rvalue
476 if (
present(dvalue))
read (io_unit%flag,*) dvalue
477 if (
present(lvalue).and.iostat==0)
read (io_unit%flag,*,iostat=iostat) lvalue
478 if (iostat/=0) lvalue = .not.lvalue
480 if (
present(lvalue))
write (io_unit%output,*)
'flag: ', file(1:index(file,
'.')-1),
' =', lvalue
481 if (
present(ivalue))
write (io_unit%output,*)
'flag: ', file(1:index(file,
'.')-1),
' =', ivalue
482 if (
present(rvalue))
write (io_unit%output,*)
'flag: ', file(1:index(file,
'.')-1),
' =', rvalue
483 if (
present(dvalue))
write (io_unit%output,*)
'flag: ', file(1:index(file,
'.')-1),
' =', dvalue
487 END SUBROUTINE check_flags
492 SUBROUTINE namelist_warning (self, namelist, error)
494 character(len=*):: namelist
495 logical,
optional:: error
498 write(stdout,
'(a)')
'' 499 write(stdout,
'(a)')
'*************************************************************************************' 500 write(stdout,
'(a)')
'*************************************************************************************' 501 if (self%namelist_errors)
then 502 write(stdout,
'(a)')
' ERROR: namelist '//trim(namelist)//
' had read error' 504 write(stdout,
'(a)')
' WARNING: namelist '//trim(namelist)//
' had read error' 506 write(stdout,
'(a)')
'*************************************************************************************' 507 write(stdout,
'(a)')
'*************************************************************************************' 508 if (self%namelist_errors)
then 509 if (
present(error))
then 511 call mpi%abort(
'Namelist error')
513 call mpi%abort(
'Namelist error')
517 END SUBROUTINE namelist_warning
522 SUBROUTINE abort (error)
523 character(len=*),
optional:: error
525 call mpi%abort (error)
531 SUBROUTINE assert (ok, message)
533 character(len=*):: message
536 call mpi%abort (message)
537 END SUBROUTINE assert
543 SUBROUTINE header (str, left)
544 character(len=*):: str
545 integer,
optional:: left
549 if (str(1:1) ==
'-')
then 550 call line (str, left)
552 call line (
'=', left)
553 call line (str, left)
554 call line (
'=', left)
561 subroutine line (s, left)
563 integer,
optional:: left
566 integer,
parameter:: w=80
567 character(len=w):: buf
568 integer:: i, j, l1, l2, l
574 if (s(1:1)==
'-')
then 581 if (
present(left))
then 591 else if (i==l1 .or. i==l2)
then 594 else if (i > l1 .and. i < l2 .and. j <= l)
then 605 END SUBROUTINE header
609 character(len=120),
save:: hl= &
610 '--------------------------------------------------------------------------------' 613 write (io_unit%output,
'(a)') trim(hl)
615 END SUBROUTINE print_hl
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...