SCALE-RM
scale_io.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
9 #include "scalelib.h"
10 module scale_io
11  !-----------------------------------------------------------------------------
12  !
13  !++ used modules
14  !
15  use scale_file_h, only: &
16  file_hshort, &
17  file_hmid, &
18  file_hlong
19  !-----------------------------------------------------------------------------
20  implicit none
21  private
22  !-----------------------------------------------------------------------------
23  !
24  !++ included parameters
25  !
26  character(len=*), parameter :: LIBVERSION = version_macro
27 
28  !-----------------------------------------------------------------------------
29  !
30  !++ Public procedure
31  !
32  public :: io_setup
33  public :: io_log_setup
34  public :: io_finalize
35  public :: io_set_universalrank
36  public :: io_get_available_fid
37  public :: io_get_fname
38  public :: io_arg_getfname
39  public :: io_cnf_open
40 
41  !-----------------------------------------------------------------------------
42  !
43  !++ Public parameters & variables
44  !
45  integer, public, parameter :: h_short = file_hshort
46  integer, public, parameter :: h_mid = file_hmid
47  integer, public, parameter :: h_long = file_hlong
48 
49  character(len=H_MID), public :: h_appname
50  character(len=H_MID), public :: h_libname
51  character(len=H_MID), public :: h_source
52  character(len=H_MID), public :: h_institute = 'RIKEN'
53 
54  character(len=9), public, parameter :: io_nullfile = "/dev/null"
55  character(len=6), public, parameter :: io_stdout = "STDOUT"
56  integer, public, parameter :: io_fid_stdout = 6
57  integer, public :: io_fid_conf = -1
58  integer, public :: io_fid_log = -1
59  integer, public :: io_fid_nml = -1
60 
61  character(len=H_LONG), public :: io_log_basename = 'LOG'
62  character(len=H_LONG), public :: io_nml_filename = ''
63  logical, public :: io_l = .false.
64  logical, public :: io_nml = .false.
65  logical, public :: io_log_suppress = .false.
66  logical, public :: io_log_nml_suppress = .false.
67  logical, public :: io_log_allnode = .false.
68  integer, public :: io_step_to_stdout = -1
69 
70  character(len=6), public :: io_universalrank = "UNKNWN"
71  character(len=6), public :: io_jobid = "UNKNWN"
72  character(len=6), public :: io_domainid = "UNKNWN"
73  character(len=6), public :: io_localrank = "UNKNWN"
74 
75  !$acc declare create(IO_L, IO_UNIVERSALRANK, IO_JOBID, IO_DOMAINID, IO_LOCALRANK)
76 
77  !-----------------------------------------------------------------------------
78  !
79  !++ Private procedure
80  !
81  !-----------------------------------------------------------------------------
82  !
83  !++ Private parameters & variables
84  !
85  integer, private, parameter :: io_minfid = 10
86  integer, private, parameter :: io_maxfid = 256
87 
88  character(len=H_LONG), private :: io_prefix
89 
90  !-----------------------------------------------------------------------------
91 contains
92  !-----------------------------------------------------------------------------
94  subroutine io_setup( &
95  APPNAME, &
96  conf_name, &
97  prefix, &
98  allow_noconf )
99 
100  implicit none
101 
102  namelist / param_io / &
103  h_source, &
104  h_institute, &
105  io_log_basename, &
106  io_nml_filename, &
107  io_log_suppress, &
108  io_log_nml_suppress, &
109  io_log_allnode, &
110  io_step_to_stdout
111 
112  character(len=*), intent(in) :: appname
113  character(len=*), intent(in), optional :: conf_name
114  character(len=*), intent(in), optional :: prefix
115  logical, intent(in), optional :: allow_noconf
116 
117  character(len=H_LONG) :: fname
118 
119  integer :: ierr
120  !---------------------------------------------------------------------------
121 
122  if ( present(conf_name) ) then
123  fname = conf_name
124  else
125  fname = io_arg_getfname( is_master=.true., allow_noconf=allow_noconf )
126  io_log_basename = io_stdout
127  endif
128 
129  if ( present(prefix) ) then
130  io_prefix = prefix
131  else
132  io_prefix = ""
133  end if
134 
135  !--- Open config file till end
136  io_fid_conf = io_cnf_open( fname, & ! [IN]
137  is_master=.true. ) ! [IN]
138 
139  h_appname = trim(appname)
140  h_libname = 'SCALE Library ver. '//trim(libversion)
141  h_source = trim(appname)
142 
143  !--- read PARAM
144  if ( io_fid_conf > 0 ) then
145  rewind(io_fid_conf)
146  read(io_fid_conf,nml=param_io,iostat=ierr)
147  if ( ierr > 0 ) then !--- fatal error
148  log_error('IO_setup',*) 'Not appropriate names in namelist PARAM_IO . Check!'
149  stop
150  endif
151  end if
152 
153  return
154  end subroutine io_setup
155 
156  !-----------------------------------------------------------------------------
158  subroutine io_log_setup( &
159  myrank, &
160  is_master )
161  implicit none
162 
163  integer, intent(in) :: myrank
164  logical, intent(in) :: is_master
165 
166  namelist / param_io / &
167  h_source, &
168  h_institute, &
169  io_log_basename, &
170  io_nml_filename, &
171  io_log_suppress, &
172  io_log_nml_suppress, &
173  io_log_allnode
174 
175  character(len=H_LONG) :: fname
176 
177  integer :: ierr
178  !---------------------------------------------------------------------------
179 
180  if ( io_log_suppress ) then
181  io_l = .false.
182  else
183  if ( is_master ) then ! master node
184  io_l = .true.
185  else
186  io_l = io_log_allnode
187  endif
188  endif
189 
190  if ( io_log_nml_suppress ) then
191  io_nml = .false.
192  else
193  io_nml = io_l
194  endif
195 
196  if ( io_l ) then
197 
198  !--- Open logfile
199  if ( io_log_basename == io_stdout ) then
200  io_fid_log = io_fid_stdout
201  else
202  io_fid_log = io_get_available_fid()
203  call io_get_fname(fname, io_log_basename, rank=myrank)
204  open( unit = io_fid_log, &
205  file = trim(fname), &
206  form = 'formatted', &
207  iostat = ierr )
208  if ( ierr /= 0 ) then
209  log_error('IO_LOG_setup',*) 'File open error! :', trim(fname)
210  stop
211  endif
212  endif
213 
214  if ( io_fid_log .ne. io_fid_stdout ) then
215  write(io_fid_log,*) ''
216  write(io_fid_log,*) ' -+++++++++; '
217  write(io_fid_log,*) ' ++++++++++++++= '
218  write(io_fid_log,*) ' ++++++++++++++++++- '
219  write(io_fid_log,*) ' +++++++++++++++++++++ '
220  write(io_fid_log,*) ' .+++++++++++++++++++++++ '
221  write(io_fid_log,*) ' +++++++++++++++++++++++++ '
222  write(io_fid_log,*) ' +++++++++++++++++++++++++++ '
223  write(io_fid_log,*) ' =++++++=x######+++++++++++++; '
224  write(io_fid_log,*) ' .++++++X####XX####++++++++++++ '
225  write(io_fid_log,*) ' =+xxx=, ++++ +++++=##+ .###++++++++++- '
226  write(io_fid_log,*) ' ,xxxxxxxxxx- +++++.+++++=## .##++++++++++ '
227  write(io_fid_log,*) ' xxxxxxxxxxxxx -+++x#;+++++#+ ##+++++++++. '
228  write(io_fid_log,*) ' xxxxxxxx##xxxx, ++++# +++++XX #+++++++++- '
229  write(io_fid_log,*) ' xxxxxxx####+xx+x ++++#.++++++# #+++++++++ '
230  write(io_fid_log,*) ' +xxxxxX#X #Xx#= =+++#x=++++=#. x=++++++++ '
231  write(io_fid_log,*) ' xxxxxx#, x### .++++#,+++++#= x++++++++ '
232  write(io_fid_log,*) ' xxxxxx#. ++++# +++++x# #++++++++ '
233  write(io_fid_log,*) ' xxxxxx+ ++++#-+++++=# #++++++++ '
234  write(io_fid_log,*) ',xxxxxX -+++XX-+++++#, +++++++++ '
235  write(io_fid_log,*) '=xxxxxX .++++#.+++++#x -++++++++ '
236  write(io_fid_log,*) '+xxxxx= ++++#.++++++# ++++++++# '
237  write(io_fid_log,*) 'xxxxxx; ++++#+=++++=# ++++++++# '
238  write(io_fid_log,*) 'xxxxxxx ,+++x#,+++++#- ;++++++++- '
239  write(io_fid_log,*) '#xxxxxx +++=# +++++xX ++++++++# '
240  write(io_fid_log,*) 'xxxxxxxx ++++#-+++++=# +++++++++X '
241  write(io_fid_log,*) '-+xxxxxx+ ++++X#-++++=#. -++; =++++++++# '
242  write(io_fid_log,*) ' #xxxxxxxx. .+++++# +++++#x =++++- +++++++++XX '
243  write(io_fid_log,*) ' #xxxxxxxxxx=--=++++++#.++++++# ++++++ -+++++++++x# '
244  write(io_fid_log,*) ' #+xxxxxxxxxx+++++++#x=++++=# ++++++;=+++++++++++x# '
245  write(io_fid_log,*) ' =#+xxxxxxxx+++++++##,+++++#= =++++++++++++++++++##. '
246  write(io_fid_log,*) ' X#xxxxxxxx++++++## +++++x# ;x++++++++++++++++##. '
247  write(io_fid_log,*) ' x##+xxxx+++++x## +++++=# ##++++++++++++x##X '
248  write(io_fid_log,*) ' ,###Xx+++x###x -++++=#, .####x+++++X####. '
249  write(io_fid_log,*) ' -########+ -#####x .X#########+. '
250  write(io_fid_log,*) ' .,. ...... .,. '
251  write(io_fid_log,*) ' '
252  write(io_fid_log,*) ' .X####### +###- =###+ ###x x######## '
253  write(io_fid_log,*) ' .######### ######X ####### #### .#########x '
254  write(io_fid_log,*) ' ####+++++= X#######. -#######x .###; ####x+++++. '
255  write(io_fid_log,*) ' ### ###= #### #### x### #### -###. '
256  write(io_fid_log,*) ' .### #### ###+ X### ###X =###. #### '
257  write(io_fid_log,*) ' ###- ;###, .###+ -### #### x##########+ '
258  write(io_fid_log,*) ' +####x #### #### #### #### ###########. '
259  write(io_fid_log,*) ' x######. =### ###, .###- ###+ x###-------- '
260  write(io_fid_log,*) ' =##### X### -### #### ,### #### '
261  write(io_fid_log,*) ' .###=x###; .###+ ###X ###X ####. '
262  write(io_fid_log,*) ' ###########; ###########+ ########### ########### ,##########. '
263  write(io_fid_log,*) '-########### ,##########, #########X ########## +######### '
264  write(io_fid_log,*) ',,,,,,,,,,. ,,,,,,,,, .,,,,,,,. .,,,,,,,, ,,,,,,,, '
265  write(io_fid_log,*) ' '
266  write(io_fid_log,*) ' SCALE : Scalable Computing by Advanced Library and Environment '
267  write(io_fid_log,*) ''
268  write(io_fid_log,*) trim(h_libname)
269  write(io_fid_log,*) trim(h_appname)
270 
271 
272  log_newline
273  log_info("IO_LOG_setup",*) 'Setup'
274 
275  log_info('IO_LOG_setup','(1x,A,I3)') 'Open config file, FID = ', io_fid_conf
276  log_info('IO_LOG_setup','(1x,A,I3)') 'Open log file, FID = ', io_fid_log
277  log_info('IO_LOG_setup','(1x,2A)') 'basename of log file = ', trim(io_log_basename)
278  log_newline
279  end if
280 
281  else
282  if( is_master ) write(*,*) '*** Log report is suppressed.'
283  endif
284 
285  if ( io_nml_filename /= '' ) then
286  call io_get_fname(fname, io_nml_filename)
287  log_info("IO_LOG_setup",*) 'The used configurations are output to the file.'
288  log_info("IO_LOG_setup",*) 'filename of used config file = ', trim(fname)
289 
290  if ( is_master ) then ! write from master node only
291  io_nml = .true. ! force on
292  io_fid_nml = io_get_available_fid()
293  open( unit = io_fid_nml, &
294  file = fname, &
295  form = 'formatted', &
296  iostat = ierr )
297  if ( ierr /= 0 ) then
298  log_error('IO_LOG_setup',*) 'File open error! :', trim(fname)
299  stop 1
300  endif
301 
302  log_info("IO_LOG_setup",'(1x,A,I3)') 'Open file to output used config, FID = ', io_fid_nml
303 
304  write(io_fid_nml,'(A)') '################################################################################'
305  write(io_fid_nml,'(A)') '#! configulation'
306  write(io_fid_nml,'(2A)') '#! ', trim(h_libname)
307  write(io_fid_nml,'(2A)') '#! ', trim(h_appname)
308  write(io_fid_nml,'(A)') '################################################################################'
309  log_nml(param_io)
310  else
311  io_nml = .false. ! force off
312  io_fid_nml = -1
313 
314  log_info("IO_LOG_setup",*) 'The file for used config is open by the master rank'
315  endif
316  else
317  if ( io_nml ) then
318  io_fid_nml = io_fid_log
319 
320  log_info("IO_LOG_setup",*) 'The used config is output to the log.'
321  else
322  log_info("IO_LOG_setup",*) 'The used config is not output.'
323  endif
324  endif
325 
326  write(io_localrank,'(I6.6)') myrank
327 
328  !$acc update device(IO_L, IO_LOCALRANK)
329 
330  return
331  end subroutine io_log_setup
332 
333  subroutine io_finalize
334  implicit none
335 
336  integer :: fid
337  logical :: i_opened
338  !---------------------------------------------------------------------------
339 
340  log_newline
341  log_progress(*) 'Closing LOG file'
342 
343  if ( io_fid_conf > 0 ) then
344  close( io_fid_conf )
345  io_fid_conf = -1
346  end if
347 
348  if ( io_fid_log > 0 .and. io_fid_log /= io_fid_stdout ) then
349  close( io_fid_log )
350  io_fid_log = -1
351  end if
352 
353  if ( io_fid_nml > 0 ) then
354  close( io_fid_nml )
355  io_fid_nml = -1
356  end if
357 
358  do fid = io_minfid, io_maxfid
359  inquire(fid,opened=i_opened)
360  if ( i_opened ) close(fid)
361  enddo
362 
363  io_l = .false.
364  io_nml = .false.
365 
366  return
367  end subroutine io_finalize
368 
369  !-----------------------------------------------------------------------------
372  function io_get_available_fid() result(fid)
373  implicit none
374 
375  integer :: fid
376  logical :: i_opened
377  !---------------------------------------------------------------------------
378 
379  do fid = io_minfid, io_maxfid
380  inquire(fid,opened=i_opened)
381  if ( .NOT. i_opened ) return
382  enddo
383 
384  if ( fid >= io_maxfid ) then ! reach limit
385  log_error("IO_get_available_fid",*) 'Used I/O unit number reached to the limit! STOP'
386  stop
387  endif
388 
389  end function io_get_available_fid
390 
391  !-----------------------------------------------------------------------------
393  subroutine io_set_universalrank( &
394  myrank, &
395  jobid, &
396  domainid )
397  implicit none
398 
399  integer, intent(in) :: myrank
400  integer, intent(in) :: jobid
401  integer, intent(in) :: domainid
402  !---------------------------------------------------------------------------
403 
404  write(io_universalrank,'(I6.6)') myrank
405  write(io_jobid ,'(I6.6)') jobid
406  write(io_domainid ,'(I6.6)') domainid
407 
408  !$acc update device(IO_UNIVERSALRANK, IO_JOBID, IO_DOMAINID)
409 
410  return
411  end subroutine io_set_universalrank
412 
413  !-----------------------------------------------------------------------------
415  subroutine io_get_fname( &
416  outstr, &
417  instr, &
418  rank, &
419  ext, &
420  len )
421  implicit none
422 
423  character(len=*), intent(out) :: outstr
424  character(len=*), intent(in) :: instr
425  integer, intent(in), optional :: rank
426  character(len=*), intent(in), optional :: ext
427  integer, intent(in), optional :: len
428 
429  integer :: len_
430  character(len=H_SHORT) :: ext_
431  character(len=8) :: srank
432  character(len=6) :: fmt
433  !---------------------------------------------------------------------------
434 
435  if ( present(rank) ) then
436  if ( present(ext) ) then
437  ext_ = ext
438  else
439  ext_ = "pe"
440  end if
441  if ( rank >= 0 ) then
442  if ( present(len) ) then
443  len_ = len
444  else
445  len_ = 6
446  end if
447  write(fmt,'(A,I1,A,I1,A)') '(I', len_, '.', len_, ')'
448  write(srank, fmt) rank
449  outstr = trim(instr)//'.'//trim(ext_)//trim(srank)
450  else
451  outstr = trim(instr)//'.'//trim(ext_)//"all"
452  end if
453  else
454  outstr = instr
455  end if
456 
457  if ( io_prefix /= "" .and. outstr(1:1) /= "/" ) then
458  outstr = trim(io_prefix) // trim(outstr)
459  end if
460 
461  return
462  end subroutine io_get_fname
463 
464  !-----------------------------------------------------------------------------
467  function io_arg_getfname( is_master, allow_noconf ) result(fname)
468  implicit none
469  logical, intent(in) :: is_master
470  logical, intent(in), optional :: allow_noconf
471 
472  character(len=H_LONG) :: fname
473  logical :: allow_noconf_
474  !---------------------------------------------------------------------------
475 
476  if ( command_argument_count() < 1 ) then
477  allow_noconf_ = .false.
478  if ( present(allow_noconf) ) allow_noconf_ = allow_noconf
479  if ( .not. allow_noconf_ ) then
480  if(is_master) then
481  log_error("IO_ARG_getfname",*) 'Program needs config file from argument! STOP.'
482  end if
483  stop
484  else
485  fname = io_nullfile
486  end if
487  else
488  call get_command_argument(1,fname)
489  endif
490 
491  end function io_arg_getfname
492 
493  !-----------------------------------------------------------------------------
496  function io_cnf_open( &
497  fname, &
498  is_master ) &
499  result(fid)
500  implicit none
501 
502  character(len=*), intent(in) :: fname
503  logical, intent(in) :: is_master
504  integer :: fid
505 
506  integer :: ierr
507  !---------------------------------------------------------------------------
508 
509  fid = io_get_available_fid()
510 
511  open( unit = fid, &
512  file = trim(fname), &
513  form = 'formatted', &
514  status = 'old', &
515  iostat = ierr )
516 
517  if ( ierr /= 0 ) then
518  if(is_master) then
519  log_error("IO_CNF_open",*) 'Failed to open config file! STOP.'
520  log_error("IO_CNF_open",*) 'filename : ', trim(fname)
521  end if
522  stop
523  endif
524 
525  end function io_cnf_open
526 
527 end module scale_io
scale_io::io_universalrank
character(len=6), public io_universalrank
universal rank for error log
Definition: scale_io.F90:70
scale_io::io_domainid
character(len=6), public io_domainid
nesting domain id for error log
Definition: scale_io.F90:72
scale_io::io_log_basename
character(len=h_long), public io_log_basename
basename of logfile
Definition: scale_io.F90:61
scale_io::io_set_universalrank
subroutine, public io_set_universalrank(myrank, jobid, domainid)
Put for error log.
Definition: scale_io.F90:397
scale_file_h::file_hlong
integer, parameter, public file_hlong
Definition: scale_file_h.F90:23
scale_io::io_jobid
character(len=6), public io_jobid
bulk job id for error log
Definition: scale_io.F90:71
scale_file_h::file_hmid
integer, parameter, public file_hmid
Definition: scale_file_h.F90:22
scale_io::io_step_to_stdout
integer, public io_step_to_stdout
interval for output current step to STDOUT (negative is off)
Definition: scale_io.F90:68
scale_io::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_io.F90:373
scale_io::h_institute
character(len=h_mid), public h_institute
for file header
Definition: scale_io.F90:52
scale_io::h_source
character(len=h_mid), public h_source
for file header
Definition: scale_io.F90:51
scale_file_h::file_hshort
integer, parameter, public file_hshort
Definition: scale_file_h.F90:21
scale_io::io_nml_filename
character(len=h_long), public io_nml_filename
filename of logfile (only for output namelist)
Definition: scale_io.F90:62
scale_io::h_mid
integer, parameter, public h_mid
Character length (short=64)
Definition: scale_io.F90:46
scale_io::io_get_fname
subroutine, public io_get_fname(outstr, instr, rank, ext, len)
generate process specific filename
Definition: scale_io.F90:421
scale_io
module STDIO
Definition: scale_io.F90:10
scale_io::io_nullfile
character(len=9), parameter, public io_nullfile
Definition: scale_io.F90:54
scale_io::h_appname
character(len=h_mid), public h_appname
name of the application
Definition: scale_io.F90:49
scale_io::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_io.F90:58
scale_io::h_short
integer, parameter, public h_short
Character length (short=16)
Definition: scale_io.F90:45
scale_io::io_finalize
subroutine, public io_finalize
Definition: scale_io.F90:334
scale_io::h_long
integer, parameter, public h_long
Character length (short=256)
Definition: scale_io.F90:47
scale_file_h
module file_h
Definition: scale_file_h.F90:11
scale_io::io_log_nml_suppress
logical, public io_log_nml_suppress
suppress all of log output? (for namelist)
Definition: scale_io.F90:66
scale_io::io_log_suppress
logical, public io_log_suppress
suppress all of log output?
Definition: scale_io.F90:65
scale_io::io_stdout
character(len=6), parameter, public io_stdout
Definition: scale_io.F90:55
scale_io::h_libname
character(len=h_mid), public h_libname
name and version of the library
Definition: scale_io.F90:50
scale_io::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_io.F90:63
scale_io::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_io.F90:59
scale_io::io_nml
logical, public io_nml
output log or not? (for namelist, this process)
Definition: scale_io.F90:64
scale_io::io_fid_stdout
integer, parameter, public io_fid_stdout
Definition: scale_io.F90:56
scale_io::io_log_allnode
logical, public io_log_allnode
output log for each node?
Definition: scale_io.F90:67
scale_io::io_log_setup
subroutine, public io_log_setup(myrank, is_master)
Setup LOG.
Definition: scale_io.F90:161
scale_io::io_arg_getfname
character(len=h_long) function, public io_arg_getfname(is_master, allow_noconf)
get config filename from argument
Definition: scale_io.F90:468
scale_io::io_cnf_open
integer function, public io_cnf_open(fname, is_master)
open config file
Definition: scale_io.F90:500
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_io::io_setup
subroutine, public io_setup(APPNAME, conf_name, prefix, allow_noconf)
Setup.
Definition: scale_io.F90:99
scale_io::io_localrank
character(len=6), public io_localrank
local rank for error log
Definition: scale_io.F90:73
Generated by   doxygen 1.8.17