SCALE-RM
scale_monitor.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
13 !-------------------------------------------------------------------------------
14 module scale_monitor
15  !-----------------------------------------------------------------------------
16  !
17  !++ Used modules
18  !
19  use scale_precision
20  use scale_stdio
21  use scale_prof
22  use scale_grid_index
23  !-----------------------------------------------------------------------------
24  implicit none
25  private
26  !-----------------------------------------------------------------------------
27  !
28  !++ Public procedures
29  !
30  public :: monit_setup
31  public :: monit_reg
32  public :: monit_put
33  public :: monit_in
34  public :: monit_write
35  public :: monit_finalize
36 
37  interface monit_in
38  module procedure monit_in_2d
39  module procedure monit_in_3d
40  end interface monit_in
41 
42  interface monit_put
43  module procedure monit_put_2d
44  module procedure monit_put_3d
45  end interface monit_put
46 
47  !-----------------------------------------------------------------------------
48  !
49  !++ Public parameters & variables
50  !
51  !-----------------------------------------------------------------------------
52  !
53  !++ Private procedures
54  !
55  private :: monit_writeheader
56 
57  !-----------------------------------------------------------------------------
58  !
59  !++ Private parameters & variables
60  !
61  integer :: MONIT_FID = -1
62 
63  character(len=H_LONG) :: MONITOR_OUT_BASENAME = 'monitor'
64  logical :: MONITOR_USEDEVATION = .true.
65  integer :: MONITOR_STEP_INTERVAL = 1
66 
67  integer, parameter :: MONIT_req_limit = 1000
68  integer :: MONIT_req_nmax = 0
69  character(len=H_SHORT) :: MONIT_req_item(MONIT_req_limit)
70 
71  integer :: MONIT_id_count = 0
72  character(len=H_SHORT), allocatable :: MONIT_item (:)
73  character(len=H_MID) , allocatable :: MONIT_desc (:)
74  character(len=H_SHORT), allocatable :: MONIT_unit (:)
75  character(len=H_SHORT), allocatable :: MONIT_ktype(:)
76  integer, allocatable :: MONIT_kmax (:)
77  real(RP), allocatable :: MONIT_var (:)
78  real(RP), allocatable :: MONIT_var0 (:)
79  logical, allocatable :: MONIT_first(:)
80  logical, allocatable :: MONIT_flux (:)
81 
82  real(RP), parameter :: eps = 1.e-10_rp
83 
84  !-----------------------------------------------------------------------------
85 contains
86  !-----------------------------------------------------------------------------
88  subroutine monit_setup
89  use scale_process, only: &
90  prc_mpistop
91  implicit none
92 
93  namelist / param_monitor / &
94  monitor_out_basename, &
95  monitor_usedevation, &
96  monitor_step_interval
97 
98  character(len=H_SHORT) :: item
99 
100  namelist / monititem / &
101  item
102 
103  integer :: ierr
104  integer :: n
105  !---------------------------------------------------------------------------
106 
107  if( io_l ) write(io_fid_log,*)
108  if( io_l ) write(io_fid_log,*) '++++++ Module[MONITOR] / Categ[IO] / Origin[SCALElib]'
109 
110  !--- read namelist
111  rewind(io_fid_conf)
112  read(io_fid_conf,nml=param_monitor,iostat=ierr)
113  if( ierr < 0 ) then !--- missing
114  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
115  elseif( ierr > 0 ) then !--- fatal error
116  write(*,*) 'xxx Not appropriate names in namelist PARAM_MONITOR. Check!'
117  call prc_mpistop
118  endif
119  if( io_nml ) write(io_fid_nml,nml=param_monitor)
120 
121  ! listup monitor request
122  rewind(io_fid_conf)
123  do n = 1, monit_req_limit
124  read(io_fid_conf,nml=monititem,iostat=ierr)
125  if( ierr /= 0 ) exit
126  enddo
127  monit_req_nmax = n - 1
128 
129  if( io_l ) write(io_fid_log,*)
130  if ( monit_req_nmax > monit_req_limit ) then
131  if( io_l ) write(io_fid_log,*) '*** request of monitor file is exceed! n >', monit_req_limit
132  elseif( monit_req_nmax == 0 ) then
133  if( io_l ) write(io_fid_log,*) '*** No monitor file specified.'
134  return
135  else
136  if( io_l ) write(io_fid_log,*) '*** Number of requested monitor item: ', monit_req_nmax
137  if( io_l ) write(io_fid_log,*) '*** Monitor output interval [step] : ', monitor_step_interval
138  if( io_l ) write(io_fid_log,*) '*** Use deviation from first step? : ', monitor_usedevation
139  endif
140 
141  allocate( monit_item(monit_req_nmax) )
142  allocate( monit_desc(monit_req_nmax) )
143  allocate( monit_unit(monit_req_nmax) )
144  allocate( monit_ktype(monit_req_nmax) )
145  allocate( monit_kmax(monit_req_nmax) )
146  allocate( monit_var(monit_req_nmax) )
147  allocate( monit_var0(monit_req_nmax) )
148  allocate( monit_first(monit_req_nmax) )
149  allocate( monit_flux(monit_req_nmax) )
150 
151  rewind(io_fid_conf)
152  do n = 1, monit_req_nmax
153  ! set default
154  item = 'unknown'
155 
156  read(io_fid_conf,nml=monititem,iostat=ierr)
157  if( ierr /= 0 ) exit
158 
159  if( io_nml .AND. io_fid_nml /= io_fid_log ) write(io_fid_nml,nml=monititem)
160 
161  monit_req_item(n) = item
162  enddo
163 
164  return
165  end subroutine monit_setup
166 
167  !-----------------------------------------------------------------------------
169  subroutine monit_reg( &
170  itemid, &
171  item, &
172  desc, &
173  unit, &
174  ndim, &
175  isflux )
176  implicit none
177 
178  integer, intent(out) :: itemid
179  character(len=*), intent(in) :: item
180  character(len=*), intent(in) :: desc
181  character(len=*), intent(in) :: unit
182  integer, intent(in) :: ndim
183  logical, intent(in) :: isflux
184 
185  character(len=8) :: lname
186 
187  integer :: n, nmax, reqid
188  !---------------------------------------------------------------------------
189 
190  !--- search existing item
191  itemid = -1
192  nmax = min( monit_id_count, monit_req_nmax )
193  do n = 1, nmax
194  if ( item == monit_item(n) ) then ! match existing item
195  itemid = n
196  return
197  endif
198  enddo
199 
200  if ( itemid < 0 ) then ! request-register matching check
201  do n = 1, monit_req_nmax
202  if ( item == monit_req_item(n) ) then
203  monit_id_count = monit_id_count + 1
204  itemid = monit_id_count
205  reqid = n
206 
207  ! new file registration
208  monit_item(itemid) = trim(item)
209  monit_desc(itemid) = trim(desc)
210  monit_unit(itemid) = trim(unit)
211  if ( ndim == 2 ) then
212  monit_ktype(itemid) = 'ZSFC'
213  monit_kmax(itemid) = 1
214  elseif( ndim == 3 ) then
215  write(lname,'(A,I4.4)') 'ZDEF', kmax
216  monit_ktype(itemid) = lname
217  monit_kmax(itemid) = kmax
218  endif
219  monit_var(itemid) = 0.0_rp
220  monit_var0(itemid) = 0.0_rp
221  monit_first(itemid) = .true.
222  monit_flux(itemid) = isflux
223 
224  if( io_l ) write(io_fid_log,*)
225  if( io_l ) write(io_fid_log,'(1x,A,I3)') ' *** [MONIT] Item registration No.= ', itemid
226  if( io_l ) write(io_fid_log,*) ' ] Name : ', trim(monit_item(itemid))
227  if( io_l ) write(io_fid_log,*) ' ] Description : ', trim(monit_desc(itemid))
228  if( io_l ) write(io_fid_log,*) ' ] Unit : ', trim(monit_unit(itemid))
229  if( io_l ) write(io_fid_log,*) ' ] Vert. type : ', trim(monit_ktype(itemid))
230  if( io_l ) write(io_fid_log,*) ' ] # of layer : ', monit_kmax(itemid)
231  if( io_l ) write(io_fid_log,*) ' ] Integ. with dt? : ', monit_flux(itemid)
232  endif
233  enddo
234  endif
235 
236  return
237  end subroutine monit_reg
238 
239  !-----------------------------------------------------------------------------
241  subroutine monit_put_2d( &
242  itemid, &
243  var )
244  use scale_time, only: &
245  dt => time_dtsec
246  use scale_rm_statistics, only: &
247  stat_total
248  implicit none
249 
250  integer, intent(in) :: itemid
251  real(RP), intent(in) :: var(:,:)
252 
253  real(RP) :: total
254  !---------------------------------------------------------------------------
255 
256  if( itemid <= 0 ) return
257 
258  call stat_total( total, var(:,:), monit_item(itemid) )
259 
260  if ( monit_flux(itemid) ) then
261  if ( monit_first(itemid) ) then
262  monit_var(itemid) = total * dt ! first put
263  monit_first(itemid) = .false.
264  else
265  monit_var(itemid) = monit_var(itemid) + total * dt ! integrate by last put
266  endif
267  else
268  if ( monitor_usedevation ) then
269  if ( monit_first(itemid) ) then
270  monit_var(itemid) = 0.0_rp
271  monit_var0(itemid) = total
272  monit_first(itemid) = .false.
273  else
274  monit_var(itemid) = total - monit_var0(itemid) ! overwrite by last put
275  endif
276  else
277  monit_var(itemid) = total ! overwrite by last put
278  endif
279  endif
280 
281  return
282  end subroutine monit_put_2d
283 
284  !-----------------------------------------------------------------------------
286  subroutine monit_put_3d( &
287  itemid, &
288  var )
289  use scale_time, only: &
290  dt => time_dtsec
291  use scale_rm_statistics, only: &
292  stat_total
293  implicit none
294 
295  integer, intent(in) :: itemid
296  real(RP), intent(in) :: var(:,:,:)
297 
298  real(RP) :: total
299  !---------------------------------------------------------------------------
300 
301  if( itemid <= 0 ) return
302 
303  call stat_total( total, var(:,:,:), monit_item(itemid) )
304 
305  if ( monit_flux(itemid) ) then
306  if ( monit_first(itemid) ) then
307  monit_var(itemid) = total * dt ! first put
308  monit_first(itemid) = .false.
309  else
310  monit_var(itemid) = monit_var(itemid) + total * dt ! integrate by last put
311  endif
312  else
313  if ( monitor_usedevation ) then
314  if ( monit_first(itemid) ) then
315  monit_var(itemid) = 0.0_rp
316  monit_var0(itemid) = total
317  monit_first(itemid) = .false.
318  else
319  monit_var(itemid) = total - monit_var0(itemid) ! overwrite by last put
320  endif
321  else
322  monit_var(itemid) = total ! overwrite by last put
323  endif
324  endif
325 
326  return
327  end subroutine monit_put_3d
328 
329  !-----------------------------------------------------------------------------
331  subroutine monit_in_2d( &
332  var, &
333  item, &
334  desc, &
335  unit, &
336  ndim, &
337  isflux )
338  implicit none
339 
340  real(RP), intent(in) :: var(:,:)
341  character(len=*), intent(in) :: item
342  character(len=*), intent(in) :: desc
343  character(len=*), intent(in) :: unit
344  integer, intent(in) :: ndim
345  logical, intent(in) :: isflux
346 
347  integer :: itemid
348  !---------------------------------------------------------------------------
349 
350  call monit_reg( itemid, item, desc, unit, ndim, isflux )
351  call monit_put( itemid, var(:,:) )
352 
353  return
354  end subroutine monit_in_2d
355 
356  !-----------------------------------------------------------------------------
358  subroutine monit_in_3d( &
359  var, &
360  item, &
361  desc, &
362  unit, &
363  ndim, &
364  isflux )
365  implicit none
366 
367  real(RP), intent(in) :: var(:,:,:)
368  character(len=*), intent(in) :: item
369  character(len=*), intent(in) :: desc
370  character(len=*), intent(in) :: unit
371  integer, intent(in) :: ndim
372  logical, intent(in) :: isflux
373 
374  integer :: itemid
375  !---------------------------------------------------------------------------
376 
377  call monit_reg( itemid, item, desc, unit, ndim, isflux )
378  call monit_put( itemid, var(:,:,:) )
379 
380  return
381  end subroutine monit_in_3d
382 
383  !-----------------------------------------------------------------------------
385  subroutine monit_write( memo )
386  use scale_time, only: &
387  nowstep => time_nowstep
388  implicit none
389 
390  character(len=*), intent(in) :: memo
391 
392  logical, save :: firsttime = .true.
393 
394  integer :: n
395  !---------------------------------------------------------------------------
396 
397  if( monit_id_count == 0 ) return
398 
399  call prof_rapstart('FILE_O_ASCII', 2)
400 
401  if (firsttime) then
402  firsttime = .false.
403  call monit_writeheader
404  endif
405 
406  if ( monit_fid > 0 ) then
407 
408  if ( mod(nowstep-1,monitor_step_interval) == 0 ) then
409  if( io_l ) write(io_fid_log,*) '*** Output Monitor'
410 
411  write(monit_fid,'(A,i7,A,A4,A)',advance='no') 'STEP=',nowstep,' (',memo,')'
412  do n = 1, monit_id_count
413  write(monit_fid,'(A,ES15.8)',advance='no') ' ',monit_var(n)
414  enddo
415  write(monit_fid,*)
416  endif
417 
418  endif
419 
420  call prof_rapend ('FILE_O_ASCII', 2)
421 
422  return
423  end subroutine monit_write
424 
425  !-----------------------------------------------------------------------------
427  subroutine monit_writeheader
428  use scale_process, only: &
429  prc_mpistop, &
430  prc_myrank, &
431  prc_ismaster
432  implicit none
433 
434  character(len=H_LONG) :: fname
435 
436  logical :: monit_l
437  integer :: ierr
438  integer :: n
439  !---------------------------------------------------------------------------
440 
441  if( io_l ) write(io_fid_log,*)
442  if( io_l ) write(io_fid_log,*) '*** [MONITOR] Output item list '
443  if( io_l ) write(io_fid_log,*) '*** Number of monitor item :', monit_req_nmax
444  if( io_l ) write(io_fid_log,'(1x,2A)') 'NAME :description ', &
445  ':UNIT :Layername'
446  if( io_l ) write(io_fid_log,'(1x,2A)') '=======================================================================', &
447  '=========================='
448  do n = 1, monit_id_count
449  if( io_l ) write(io_fid_log,'(1x,A24,A48,A16,A16)') monit_item(n), monit_desc(n), monit_unit(n), monit_ktype(n)
450  enddo
451  if( io_l ) write(io_fid_log,'(1x,2A)') '=======================================================================', &
452  '=========================='
453 
454  if ( prc_ismaster ) then ! master node
455  monit_l = .true.
456  else
457  monit_l = io_log_allnode
458  endif
459 
460  if ( monit_l ) then
461 
462  !--- Open logfile
463  monit_fid = io_get_available_fid()
464  call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
465  open( unit = monit_fid, &
466  file = trim(fname), &
467  form = 'formatted', &
468  iostat = ierr )
469  if ( ierr /= 0 ) then
470  write(*,*) 'xxx File open error! :', trim(fname)
471  call prc_mpistop
472  endif
473 
474  if( io_l ) write(io_fid_log,*)
475  if( io_l ) write(io_fid_log,*) '*** Open ASCII file for monitor, name : ', trim(fname)
476 
477  write(monit_fid,'(A)',advance='no') ' '
478  do n = 1, monit_id_count
479  write(monit_fid,'(A16)',advance='no') monit_item(n)
480  enddo
481  write(monit_fid,*)
482 
483  endif
484 
485  return
486  end subroutine monit_writeheader
487 
488  !-----------------------------------------------------------------------------
490  subroutine monit_finalize
491  use scale_process, only: &
492  prc_myrank
493  implicit none
494 
495  character(len=H_LONG) :: fname
496  !---------------------------------------------------------------------------
497 
498  if ( monit_fid > 0 ) then
499  call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
500 
501  if( io_l ) write(io_fid_log,*)
502  if( io_l ) write(io_fid_log,*) '*** Close ASCII file for monitor, name : ', trim(fname)
503 
504  close(monit_fid)
505  endif
506 
507  return
508  end subroutine monit_finalize
509 
510 end module scale_monitor
scale_time::time_nowstep
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
scale_monitor::monit_finalize
subroutine, public monit_finalize
Close file.
Definition: scale_monitor.F90:491
scale_process::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_process.F90:80
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:61
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
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_rm_statistics
module Statistics
Definition: scale_rm_statistics.F90:14
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_stdio::io_nml
logical, public io_nml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:62
scale_monitor::monit_in_2d
subroutine monit_in_2d(var, item, desc, unit, ndim, isflux)
Wrapper routine of MONIT_reg+MONIT_put.
Definition: scale_monitor.F90:338
scale_stdio::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_stdio.F90:313
scale_time::time_dtsec
real(dp), public time_dtsec
time interval of model [sec]
Definition: scale_time.F90:36
scale_monitor::monit_reg
subroutine, public monit_reg(itemid, item, desc, unit, ndim, isflux)
Search existing item, or matching check between requested and registered item.
Definition: scale_monitor.F90:176
scale_monitor
module MONITOR
Definition: scale_monitor.F90:14
scale_grid_index::kmax
integer, public kmax
of computational cells: z, local
Definition: scale_grid_index.F90:43
scale_stdio::io_log_allnode
logical, public io_log_allnode
output log for each node?
Definition: scale_stdio.F90:65
scale_time
module TIME
Definition: scale_time.F90:15
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_process::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_process.F90:79
scale_monitor::monit_put_3d
subroutine monit_put_3d(itemid, var)
Put total value to the monitor buffer.
Definition: scale_monitor.F90:289
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:156
scale_prof
module profiler
Definition: scale_prof.F90:10
scale_monitor::monit_write
subroutine, public monit_write(memo)
Flush monitor buffer to formatted file.
Definition: scale_monitor.F90:386
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_monitor::monit_setup
subroutine, public monit_setup
Setup.
Definition: scale_monitor.F90:89
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:204
scale_stdio::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_stdio.F90:57
Generated by   doxygen 1.8.14