SCALE-RM
scale_stdio.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
12 module scale_stdio
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use gtool_file_h, only: &
18  file_hshort, &
19  file_hmid, &
20  file_hlong
21  !-----------------------------------------------------------------------------
22  implicit none
23  private
24  !-----------------------------------------------------------------------------
25  !
26  !++ included parameters
27  !
28 #include "scalelib.h"
29  !-----------------------------------------------------------------------------
30  !
31  !++ Public procedure
32  !
33  public :: io_setup
34  public :: io_log_setup
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_modelname
49  character(len=H_MID), public :: h_libname
50  character(len=H_MID), public :: h_source
51  character(len=H_MID), public :: h_institute = 'AICS/RIKEN'
52 
53  character(len=6), public, parameter :: io_stdout = "STDOUT"
54  integer, public, parameter :: io_fid_stdout = 6
55  integer, public :: io_fid_conf = 7
56  integer, public :: io_fid_log = 8
57  integer, public :: io_fid_nml = 9
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  logical, public :: io_aggregate = .false.
67  integer, public :: io_step_to_stdout = -1
68 
69  !-----------------------------------------------------------------------------
70  !
71  !++ Private procedure
72  !
73  !-----------------------------------------------------------------------------
74  !
75  !++ Private parameters & variables
76  !
77  integer, private, parameter :: io_minfid = 10
78  integer, private, parameter :: io_maxfid = 99
79 
80  !-----------------------------------------------------------------------------
81 contains
82  !-----------------------------------------------------------------------------
84  subroutine io_setup( &
85  MODELNAME, &
86  call_from_launcher, &
87  fname_in )
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  io_aggregate
100 
101  character(len=*), intent(in) :: modelname
102  logical, intent(in) :: call_from_launcher
103  character(len=*), intent(in), optional :: fname_in
104 
105  character(len=H_LONG) :: fname
106 
107  integer :: ierr
108  !---------------------------------------------------------------------------
109 
110  if ( call_from_launcher ) then
111  if ( present(fname_in) ) then
112  fname = fname_in
113  else
114  write(*,*) 'xxx Not imported name of config file! STOP.'
115  stop 1
116  endif
117  else
118  fname = io_arg_getfname( is_master=.true. )
119  endif
120 
121  !--- Open config file till end
122  io_fid_conf = io_cnf_open( fname, & ! [IN]
123  is_master=.true. ) ! [IN]
124 
125  h_modelname = trim(modelname)
126  h_libname = 'SCALE Library ver. '//trim(libversion)
127  h_source = trim(modelname)
128 
129  !--- read PARAM
130  rewind(io_fid_conf)
131  read(io_fid_conf,nml=param_io,iostat=ierr)
132  if ( ierr > 0 ) then !--- fatal error
133  write(*,*) 'xxx Not appropriate names in namelist PARAM_IO . Check!'
134  stop 1
135  endif
136 
137  return
138  end subroutine io_setup
139 
140  !-----------------------------------------------------------------------------
142  subroutine io_log_setup( &
143  myrank, &
144  is_master )
145  implicit none
146 
147  integer, intent(in) :: myrank
148  logical, intent(in) :: is_master
149 
150  namelist / param_io / &
151  h_source, &
152  h_institute, &
153  io_log_basename, &
154  io_nml_filename, &
155  io_log_suppress, &
156  io_log_nml_suppress, &
157  io_log_allnode, &
158  io_aggregate
159 
160  character(len=H_LONG) :: fname
161 
162  integer :: ierr
163  !---------------------------------------------------------------------------
164 
165  if ( io_log_suppress ) then
166  io_l = .false.
167  else
168  if ( is_master ) then ! master node
169  io_l = .true.
170  else
171  io_l = io_log_allnode
172  endif
173  endif
174 
175  if ( io_log_nml_suppress ) then
176  io_nml = .false.
177  else
178  io_nml = io_l
179  endif
180 
181  if ( io_l ) then
182 
183  !--- Open logfile
184  if ( io_log_basename == io_stdout ) then
185  io_fid_log = io_fid_stdout
186  else
187  io_fid_log = io_get_available_fid()
188  call io_make_idstr(fname,trim(io_log_basename),'pe',myrank)
189  open( unit = io_fid_log, &
190  file = trim(fname), &
191  form = 'formatted', &
192  iostat = ierr )
193  if ( ierr /= 0 ) then
194  write(*,*) 'xxx File open error! :', trim(fname)
195  stop 1
196  endif
197  endif
198 
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,*) ' .+++++++++++++++++++++++ '
205  write(io_fid_log,*) ' +++++++++++++++++++++++++ '
206  write(io_fid_log,*) ' +++++++++++++++++++++++++++ '
207  write(io_fid_log,*) ' =++++++=x######+++++++++++++; '
208  write(io_fid_log,*) ' .++++++X####XX####++++++++++++ '
209  write(io_fid_log,*) ' =+xxx=, ++++ +++++=##+ .###++++++++++- '
210  write(io_fid_log,*) ' ,xxxxxxxxxx- +++++.+++++=## .##++++++++++ '
211  write(io_fid_log,*) ' xxxxxxxxxxxxx -+++x#;+++++#+ ##+++++++++. '
212  write(io_fid_log,*) ' xxxxxxxx##xxxx, ++++# +++++XX #+++++++++- '
213  write(io_fid_log,*) ' xxxxxxx####+xx+x ++++#.++++++# #+++++++++ '
214  write(io_fid_log,*) ' +xxxxxX#X #Xx#= =+++#x=++++=#. x=++++++++ '
215  write(io_fid_log,*) ' xxxxxx#, x### .++++#,+++++#= x++++++++ '
216  write(io_fid_log,*) ' xxxxxx#. ++++# +++++x# #++++++++ '
217  write(io_fid_log,*) ' xxxxxx+ ++++#-+++++=# #++++++++ '
218  write(io_fid_log,*) ',xxxxxX -+++XX-+++++#, +++++++++ '
219  write(io_fid_log,*) '=xxxxxX .++++#.+++++#x -++++++++ '
220  write(io_fid_log,*) '+xxxxx= ++++#.++++++# ++++++++# '
221  write(io_fid_log,*) 'xxxxxx; ++++#+=++++=# ++++++++# '
222  write(io_fid_log,*) 'xxxxxxx ,+++x#,+++++#- ;++++++++- '
223  write(io_fid_log,*) '#xxxxxx +++=# +++++xX ++++++++# '
224  write(io_fid_log,*) 'xxxxxxxx ++++#-+++++=# +++++++++X '
225  write(io_fid_log,*) '-+xxxxxx+ ++++X#-++++=#. -++; =++++++++# '
226  write(io_fid_log,*) ' #xxxxxxxx. .+++++# +++++#x =++++- +++++++++XX '
227  write(io_fid_log,*) ' #xxxxxxxxxx=--=++++++#.++++++# ++++++ -+++++++++x# '
228  write(io_fid_log,*) ' #+xxxxxxxxxx+++++++#x=++++=# ++++++;=+++++++++++x# '
229  write(io_fid_log,*) ' =#+xxxxxxxx+++++++##,+++++#= =++++++++++++++++++##. '
230  write(io_fid_log,*) ' X#xxxxxxxx++++++## +++++x# ;x++++++++++++++++##. '
231  write(io_fid_log,*) ' x##+xxxx+++++x## +++++=# ##++++++++++++x##X '
232  write(io_fid_log,*) ' ,###Xx+++x###x -++++=#, .####x+++++X####. '
233  write(io_fid_log,*) ' -########+ -#####x .X#########+. '
234  write(io_fid_log,*) ' .,. ...... .,. '
235  write(io_fid_log,*) ' '
236  write(io_fid_log,*) ' .X####### +###- =###+ ###x x######## '
237  write(io_fid_log,*) ' .######### ######X ####### #### .#########x '
238  write(io_fid_log,*) ' ####+++++= X#######. -#######x .###; ####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 #### #### #### #### ###########. '
243  write(io_fid_log,*) ' x######. =### ###, .###- ###+ x###-------- '
244  write(io_fid_log,*) ' =##### X### -### #### ,### #### '
245  write(io_fid_log,*) ' .###=x###; .###+ ###X ###X ####. '
246  write(io_fid_log,*) ' ###########; ###########+ ########### ########### ,##########. '
247  write(io_fid_log,*) '-########### ,##########, #########X ########## +######### '
248  write(io_fid_log,*) ',,,,,,,,,,. ,,,,,,,,, .,,,,,,,. .,,,,,,,, ,,,,,,,, '
249  write(io_fid_log,*) ' '
250  write(io_fid_log,*) ' SCALE : Scalable Computing by Advanced Library and Environment '
251  write(io_fid_log,*) ''
252  write(io_fid_log,*) trim(h_libname)
253  write(io_fid_log,*) trim(h_modelname)
254  write(io_fid_log,*) ''
255  write(io_fid_log,*) '++++++ Module[STDIO] / Categ[IO] / Origin[SCALElib]'
256  write(io_fid_log,*) ''
257  write(io_fid_log,'(1x,A,I3)') '*** Open config file, FID = ', io_fid_conf
258  write(io_fid_log,'(1x,A,I3)') '*** Open log file, FID = ', io_fid_log
259  write(io_fid_log,'(1x,2A)') '*** basename of log file = ', trim(io_log_basename)
260  write(io_fid_log,*) ''
261 
262  else
263  if( is_master ) write(*,*) '*** Log report is suppressed.'
264  endif
265 
266  if ( io_nml_filename /= '' ) then
267  if( io_l ) write(io_fid_log,*) '*** The used config is output to the file.'
268  if( io_l ) write(io_fid_log,'(1x,2A)') '*** 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  write(*,*) 'xxx File open error! :', trim(io_nml_filename)
279  stop 1
280  endif
281 
282  if( io_l ) write(io_fid_log,'(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_modelname)
288  write(io_fid_nml,'(A)') '################################################################################'
289  write(io_fid_nml,nml=param_io)
290  else
291  io_nml = .false. ! force off
292  io_fid_nml = -1
293 
294  if( io_l ) write(io_fid_log,*) '*** 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  if( io_l ) write(io_fid_log,*) '*** The used config is output to the log.'
301  else
302  if( io_l ) write(io_fid_log,*) '*** 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 ) result(fname)
360  implicit none
361 
362  logical, intent(in) :: is_master
363 
364  character(len=H_LONG) :: fname
365  !---------------------------------------------------------------------------
366 
367  if ( command_argument_count() < 1 ) then
368  if(is_master) write(*,*) 'xxx Program needs config file from argument! STOP.'
369  stop 1
370  else
371  call get_command_argument(1,fname)
372  endif
373 
374  end function io_arg_getfname
375 
376  !-----------------------------------------------------------------------------
379  function io_cnf_open( &
380  fname, &
381  is_master ) &
382  result(fid)
383  implicit none
384 
385  character(len=*), intent(in) :: fname
386  logical, intent(in) :: is_master
387  integer :: fid
388 
389  integer :: ierr
390  !---------------------------------------------------------------------------
391 
392  fid = io_get_available_fid()
393 
394  open( unit = fid, &
395  file = trim(fname), &
396  form = 'formatted', &
397  status = 'old', &
398  iostat = ierr )
399 
400  if ( ierr /= 0 ) then
401  if(is_master) write(*,*) 'xxx Failed to open config file! STOP.'
402  if(is_master) write(*,*) 'xxx filename : ', trim(fname)
403  stop 1
404  endif
405 
406  end function io_cnf_open
407 
408 end module scale_stdio
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:61
gtool_file_h::file_hlong
integer, parameter, public file_hlong
Definition: gtool_file_h.f90:40
scale_stdio::h_long
integer, parameter, public h_long
Character length (short=256)
Definition: scale_stdio.F90:46
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_stdio::io_fid_stdout
integer, parameter, public io_fid_stdout
Definition: scale_stdio.F90:54
scale_stdio::io_make_idstr
subroutine, public io_make_idstr(outstr, instr, ext, rank, isrgn)
generate process specific filename
Definition: scale_stdio.F90:334
scale_stdio::io_arg_getfname
character(len=h_long) function, public io_arg_getfname(is_master)
get config filename from argument
Definition: scale_stdio.F90:360
scale_stdio::h_modelname
character(len=h_mid), public h_modelname
name and version of the model
Definition: scale_stdio.F90:48
gtool_file_h::file_hmid
integer, parameter, public file_hmid
Definition: gtool_file_h.f90:39
scale_stdio::io_log_setup
subroutine, public io_log_setup(myrank, is_master)
Setup LOG.
Definition: scale_stdio.F90:145
scale_stdio::io_stdout
character(len=6), parameter, public io_stdout
Definition: scale_stdio.F90:53
scale_stdio::io_log_suppress
logical, public io_log_suppress
suppress all of log output?
Definition: scale_stdio.F90:63
scale_stdio::io_step_to_stdout
integer, public io_step_to_stdout
interval for output current step to STDOUT (negative is off)
Definition: scale_stdio.F90:67
scale_stdio::io_nml
logical, public io_nml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:62
scale_stdio::h_source
character(len=h_mid), public h_source
for file header
Definition: scale_stdio.F90:50
scale_stdio::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_stdio.F90:313
scale_stdio::io_setup
subroutine, public io_setup(MODELNAME, call_from_launcher, fname_in)
Setup.
Definition: scale_stdio.F90:88
scale_stdio::io_log_allnode
logical, public io_log_allnode
output log for each node?
Definition: scale_stdio.F90:65
scale_stdio::h_short
integer, parameter, public h_short
Character length (short=16)
Definition: scale_stdio.F90:44
scale_stdio::h_institute
character(len=h_mid), public h_institute
for file header
Definition: scale_stdio.F90:51
scale_stdio::io_aggregate
logical, public io_aggregate
do parallel I/O through PnetCDF
Definition: scale_stdio.F90:66
gtool_file_h
module FILE I/O HEADER
Definition: gtool_file_h.f90:14
gtool_file_h::file_hshort
integer, parameter, public file_hshort
Definition: gtool_file_h.f90:38
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_stdio::h_libname
character(len=h_mid), public h_libname
name and version of the library
Definition: scale_stdio.F90:49
scale_stdio::h_mid
integer, parameter, public h_mid
Character length (short=64)
Definition: scale_stdio.F90:45
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_stdio::io_log_basename
character(len=h_long), public io_log_basename
basename of logfile
Definition: scale_stdio.F90:59
scale_stdio::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_stdio.F90:57
scale_stdio::io_log_nml_suppress
logical, public io_log_nml_suppress
suppress all of log output? (for namelist)
Definition: scale_stdio.F90:64
scale_stdio::io_cnf_open
integer function, public io_cnf_open(fname, is_master)
open config file
Definition: scale_stdio.F90:383
scale_stdio::io_nml_filename
character(len=h_long), public io_nml_filename
filename of logfile (only for output namelist)
Definition: scale_stdio.F90:60
Generated by   doxygen 1.8.14