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