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