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_lnml ) write(io_fid_log,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  monit_req_item(n) = item
160  enddo
161 
162  return
163  end subroutine monit_setup
164 
165  !-----------------------------------------------------------------------------
167  subroutine monit_reg( &
168  itemid, &
169  item, &
170  desc, &
171  unit, &
172  ndim, &
173  isflux )
174  implicit none
175 
176  integer, intent(out) :: itemid
177  character(len=*), intent(in) :: item
178  character(len=*), intent(in) :: desc
179  character(len=*), intent(in) :: unit
180  integer, intent(in) :: ndim
181  logical, intent(in) :: isflux
182 
183  character(len=8) :: lname
184 
185  integer :: n, nmax, reqid
186  !---------------------------------------------------------------------------
187 
188  !--- search existing item
189  itemid = -1
190  nmax = min( monit_id_count, monit_req_nmax )
191  do n = 1, nmax
192  if ( item == monit_item(n) ) then ! match existing item
193  itemid = n
194  return
195  endif
196  enddo
197 
198  if ( itemid < 0 ) then ! request-register matching check
199  do n = 1, monit_req_nmax
200  if ( item == monit_req_item(n) ) then
201  monit_id_count = monit_id_count + 1
202  itemid = monit_id_count
203  reqid = n
204 
205  ! new file registration
206  monit_item(itemid) = trim(item)
207  monit_desc(itemid) = trim(desc)
208  monit_unit(itemid) = trim(unit)
209  if ( ndim == 2 ) then
210  monit_ktype(itemid) = 'ZSFC'
211  monit_kmax(itemid) = 1
212  elseif( ndim == 3 ) then
213  write(lname,'(A,I4.4)') 'ZDEF', kmax
214  monit_ktype(itemid) = lname
215  monit_kmax(itemid) = kmax
216  endif
217  monit_var(itemid) = 0.0_rp
218  monit_var0(itemid) = 0.0_rp
219  monit_first(itemid) = .true.
220  monit_flux(itemid) = isflux
221 
222  if( io_l ) write(io_fid_log,*)
223  if( io_l ) write(io_fid_log,'(1x,A,I3)') ' *** [MONIT] Item registration No.= ', itemid
224  if( io_l ) write(io_fid_log,*) ' ] Name : ', trim(monit_item(itemid))
225  if( io_l ) write(io_fid_log,*) ' ] Description : ', trim(monit_desc(itemid))
226  if( io_l ) write(io_fid_log,*) ' ] Unit : ', trim(monit_unit(itemid))
227  if( io_l ) write(io_fid_log,*) ' ] Vert. type : ', trim(monit_ktype(itemid))
228  if( io_l ) write(io_fid_log,*) ' ] # of layer : ', monit_kmax(itemid)
229  if( io_l ) write(io_fid_log,*) ' ] Integ. with dt? : ', monit_flux(itemid)
230  endif
231  enddo
232  endif
233 
234  return
235  end subroutine monit_reg
236 
237  !-----------------------------------------------------------------------------
239  subroutine monit_put_2d( &
240  itemid, &
241  var )
242  use scale_time, only: &
243  dt => time_dtsec
244  use scale_rm_statistics, only: &
245  stat_total
246  implicit none
247 
248  integer, intent(in) :: itemid
249  real(RP), intent(in) :: var(:,:)
250 
251  real(RP) :: total
252  !---------------------------------------------------------------------------
253 
254  if( itemid <= 0 ) return
255 
256  call stat_total( total, var(:,:), monit_item(itemid) )
257 
258  if ( monit_flux(itemid) ) then
259  if ( monit_first(itemid) ) then
260  monit_var(itemid) = total * dt ! first put
261  monit_first(itemid) = .false.
262  else
263  monit_var(itemid) = monit_var(itemid) + total * dt ! integrate by last put
264  endif
265  else
266  if ( monitor_usedevation ) then
267  if ( monit_first(itemid) ) then
268  monit_var(itemid) = 0.0_rp
269  monit_var0(itemid) = total
270  monit_first(itemid) = .false.
271  else
272  monit_var(itemid) = total - monit_var0(itemid) ! overwrite by last put
273  endif
274  else
275  monit_var(itemid) = total ! overwrite by last put
276  endif
277  endif
278 
279  return
280  end subroutine monit_put_2d
281 
282  !-----------------------------------------------------------------------------
284  subroutine monit_put_3d( &
285  itemid, &
286  var )
287  use scale_time, only: &
288  dt => time_dtsec
289  use scale_rm_statistics, only: &
290  stat_total
291  implicit none
292 
293  integer, intent(in) :: itemid
294  real(RP), intent(in) :: var(:,:,:)
295 
296  real(RP) :: total
297  !---------------------------------------------------------------------------
298 
299  if( itemid <= 0 ) return
300 
301  call stat_total( total, var(:,:,:), monit_item(itemid) )
302 
303  if ( monit_flux(itemid) ) then
304  if ( monit_first(itemid) ) then
305  monit_var(itemid) = total * dt ! first put
306  monit_first(itemid) = .false.
307  else
308  monit_var(itemid) = monit_var(itemid) + total * dt ! integrate by last put
309  endif
310  else
311  if ( monitor_usedevation ) then
312  if ( monit_first(itemid) ) then
313  monit_var(itemid) = 0.0_rp
314  monit_var0(itemid) = total
315  monit_first(itemid) = .false.
316  else
317  monit_var(itemid) = total - monit_var0(itemid) ! overwrite by last put
318  endif
319  else
320  monit_var(itemid) = total ! overwrite by last put
321  endif
322  endif
323 
324  return
325  end subroutine monit_put_3d
326 
327  !-----------------------------------------------------------------------------
329  subroutine monit_in_2d( &
330  var, &
331  item, &
332  desc, &
333  unit, &
334  ndim, &
335  isflux )
336  implicit none
337 
338  real(RP), intent(in) :: var(:,:)
339  character(len=*), intent(in) :: item
340  character(len=*), intent(in) :: desc
341  character(len=*), intent(in) :: unit
342  integer, intent(in) :: ndim
343  logical, intent(in) :: isflux
344 
345  integer :: itemid
346  !---------------------------------------------------------------------------
347 
348  call monit_reg( itemid, item, desc, unit, ndim, isflux )
349  call monit_put( itemid, var(:,:) )
350 
351  return
352  end subroutine monit_in_2d
353 
354  !-----------------------------------------------------------------------------
356  subroutine monit_in_3d( &
357  var, &
358  item, &
359  desc, &
360  unit, &
361  ndim, &
362  isflux )
363  implicit none
364 
365  real(RP), intent(in) :: var(:,:,:)
366  character(len=*), intent(in) :: item
367  character(len=*), intent(in) :: desc
368  character(len=*), intent(in) :: unit
369  integer, intent(in) :: ndim
370  logical, intent(in) :: isflux
371 
372  integer :: itemid
373  !---------------------------------------------------------------------------
374 
375  call monit_reg( itemid, item, desc, unit, ndim, isflux )
376  call monit_put( itemid, var(:,:,:) )
377 
378  return
379  end subroutine monit_in_3d
380 
381  !-----------------------------------------------------------------------------
383  subroutine monit_write( memo )
384  use scale_time, only: &
385  nowstep => time_nowstep
386  implicit none
387 
388  character(len=4), intent(in) :: memo
389 
390  logical, save :: firsttime = .true.
391 
392  integer :: n
393  !---------------------------------------------------------------------------
394 
395  if( monit_id_count == 0 ) return
396 
397  call prof_rapstart('FILE_O_ASCII', 2)
398 
399  if (firsttime) then
400  firsttime = .false.
401  call monit_writeheader
402  endif
403 
404  if ( monit_fid > 0 ) then
405 
406  if ( mod(nowstep-1,monitor_step_interval) == 0 ) then
407  write(monit_fid,'(A,i7,A,A,A)',advance='no') 'STEP=',nowstep,' (',memo,')'
408  do n = 1, monit_id_count
409  write(monit_fid,'(A,ES15.8)',advance='no') ' ',monit_var(n)
410  enddo
411  write(monit_fid,*)
412  endif
413 
414  endif
415 
416  call prof_rapend ('FILE_O_ASCII', 2)
417 
418  return
419  end subroutine monit_write
420 
421  !-----------------------------------------------------------------------------
423  subroutine monit_writeheader
424  use scale_process, only: &
425  prc_mpistop, &
426  prc_myrank, &
427  prc_ismaster
428  implicit none
429 
430  character(len=H_LONG) :: fname
431 
432  logical :: MONIT_L
433  integer :: ierr
434  integer :: n
435  !---------------------------------------------------------------------------
436 
437  if( io_l ) write(io_fid_log,*)
438  if( io_l ) write(io_fid_log,*) '*** [MONITOR] Output item list '
439  if( io_l ) write(io_fid_log,*) '*** Number of monitor item :', monit_req_nmax
440  if( io_l ) write(io_fid_log,*)
441  if( io_l ) write(io_fid_log,'(1x,A,A)') 'NAME :description ', &
442  ' :UNIT :Layername'
443  if( io_l ) write(io_fid_log,'(1x,A,A)') '=====================================================', &
444  '====================================================='
445  do n = 1, monit_id_count
446  if( io_l ) write(io_fid_log,'(1x,A,A,A,A)') monit_item(n), monit_desc(n), monit_unit(n), monit_ktype(n)
447  enddo
448  if( io_l ) write(io_fid_log,'(1x,A,A)') '=====================================================', &
449  '====================================================='
450 
451  if ( prc_ismaster ) then ! master node
452  monit_l = .true.
453  else
454  monit_l = io_log_allnode
455  endif
456 
457  if ( monit_l ) then
458 
459  !--- Open logfile
460  monit_fid = io_get_available_fid()
461  call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
462  open( unit = monit_fid, &
463  file = trim(fname), &
464  form = 'formatted', &
465  iostat = ierr )
466  if ( ierr /= 0 ) then
467  write(*,*) 'xxx File open error! :', trim(fname)
468  call prc_mpistop
469  endif
470 
471  if( io_l ) write(io_fid_log,*)
472  if( io_l ) write(io_fid_log,*) '*** Write monitor. filename : ', fname
473 
474  write(monit_fid,'(A)',advance='no') ' '
475  do n = 1, monit_id_count
476  write(monit_fid,'(A,A16)',advance='no') monit_item(n)
477  enddo
478  write(monit_fid,*)
479 
480  endif
481 
482  return
483  end subroutine monit_writeheader
484 
485  !-----------------------------------------------------------------------------
487  subroutine monit_finalize
488  use scale_process, only: &
489  prc_myrank
490  implicit none
491 
492  character(len=H_LONG) :: fname
493  !---------------------------------------------------------------------------
494 
495  if ( monit_fid > 0 ) then
496  close(monit_fid)
497 
498  call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
499  if( io_l ) write(io_fid_log,*) '*** [MONITOR] File Close'
500  if( io_l ) write(io_fid_log,*) '*** closed filename: ', fname
501  endif
502 
503  return
504  end subroutine monit_finalize
505 
506 end module scale_monitor
507 !-------------------------------------------------------------------------------
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:488
scale_process::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_process.F90:79
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:59
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_rm_statistics
module Statistics
Definition: scale_rm_statistics.F90:14
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
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:336
scale_stdio::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_stdio.F90:253
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:174
scale_monitor
module MONITOR
Definition: scale_monitor.F90:14
scale_stdio::io_make_idstr
subroutine, public io_make_idstr(outstr, instr, ext, rank)
generate process specific filename
Definition: scale_stdio.F90:273
scale_grid_index::kmax
integer, public kmax
of computational cells: z
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:62
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:78
scale_monitor::monit_put_3d
subroutine monit_put_3d(itemid, var)
Put total value to the monitor buffer.
Definition: scale_monitor.F90:287
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:132
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:384
scale_stdio::io_lnml
logical, public io_lnml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:60
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:178
Generated by   doxygen 1.8.13