SCALE-RM
scale_monitor.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
13  !-----------------------------------------------------------------------------
14  !
15  !++ Used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20  !-----------------------------------------------------------------------------
21  implicit none
22  private
23  !-----------------------------------------------------------------------------
24  !
25  !++ Public procedures
26  !
27  public :: monitor_setup
28  public :: monitor_set_dim
29  public :: monitor_reg
30  public :: monitor_put
31  public :: monitor_in
32  public :: monitor_write
33  public :: monitor_finalize
34 
35  interface monitor_in
36  module procedure monitor_in_2d
37  module procedure monitor_in_3d
38  end interface monitor_in
39 
40  interface monitor_put
41  module procedure monitor_put_2d
42  module procedure monitor_put_3d
43  end interface monitor_put
44 
45  !-----------------------------------------------------------------------------
46  !
47  !++ Public parameters & variables
48  !
49  !-----------------------------------------------------------------------------
50  !
51  !++ Private procedures
52  !
53  private :: monitor_writeheader
54 
55  !-----------------------------------------------------------------------------
56  !
57  !++ Private parameters & variables
58  !
59  integer :: MONITOR_FID = -1
60 
61  character(len=H_LONG) :: MONITOR_OUT_BASENAME = 'monitor'
62  logical :: MONITOR_USEDEVIATION = .true.
63  integer :: MONITOR_STEP_INTERVAL = 1
64  logical :: MONITOR_GLOBAL_SUM = .true.
65 
66  real(DP) :: MONITOR_dt
67 
68  integer, parameter :: MONITOR_req_max = 1000
69  integer :: MONITOR_nreqs = 0
70  character(len=H_SHORT) :: MONITOR_reqs(MONITOR_req_max)
71 
72  type item
73  character(len=H_SHORT) :: name
74  character(len=H_MID) :: desc
75  character(len=H_SHORT) :: unit
76  real(DP) :: var
77  real(DP) :: var0
78  logical :: first
79  logical :: tendency
80  integer :: dimid
81  end type item
82  integer :: MONITOR_nitems = 0
83  type(item), allocatable :: MONITOR_items(:)
84 
85  type dim_type
86  character(len=H_SHORT) :: name
87  integer :: KA, KS, KE
88  integer :: IA, IS, IE
89  integer :: JA, JS, JE
90  integer :: dim_size
91  real(RP), allocatable :: area(:,:)
92  real(RP) :: total_area
93  real(RP), allocatable :: volume(:,:,:)
94  real(RP) :: total_volume
95  end type dim_type
96  integer, parameter :: MONITOR_dim_max = 30
97  integer :: MONITOR_ndims = 0
98  type(dim_type) :: MONITOR_dims(MONITOR_dim_max)
99 
100  !-----------------------------------------------------------------------------
101 contains
102  !-----------------------------------------------------------------------------
104  subroutine monitor_setup( dt )
105  use scale_prc, only: &
106  prc_abort
107  implicit none
108 
109  real(dp), intent(in) :: dt
110 
111  namelist / param_monitor / &
112  monitor_out_basename, &
113  monitor_usedeviation, &
114  monitor_global_sum, &
115  monitor_step_interval
116 
117  character(len=H_SHORT) :: name
118 
119  namelist / monitor_item / &
120  name
121 
122  integer :: ierr
123  integer :: n
124  !---------------------------------------------------------------------------
125 
126  log_newline
127  log_info("MONITOR_setup",*) 'Setup'
128 
129  !--- read namelist
130  rewind(io_fid_conf)
131  read(io_fid_conf,nml=param_monitor,iostat=ierr)
132  if( ierr < 0 ) then !--- missing
133  log_info('MONITOR_setup',*) 'Not found namelist. Default used.'
134  elseif( ierr > 0 ) then !--- fatal error
135  log_error('MONITOR_setup',*) 'Not appropriate names in namelist PARAM_MONITOR. Check!'
136  call prc_abort
137  endif
138  log_nml(param_monitor)
139 
140  ! listup monitor request
141  rewind(io_fid_conf)
142  do n = 1, monitor_req_max
143  read(io_fid_conf,nml=monitor_item,iostat=ierr)
144  if( ierr /= 0 ) exit
145  enddo
146  monitor_nreqs = n - 1
147 
148  if ( monitor_nreqs > monitor_req_max ) then
149  log_error('MONITOR_setup',*) 'request of monitor file is exceed! n >', monitor_req_max
150  call prc_abort
151  elseif( monitor_nreqs == 0 ) then
152  log_info('MONITOR_setup',*) 'No monitor file specified.'
153  return
154  else
155  log_info('MONITOR_setup',*) 'Number of requested monitor item : ', monitor_nreqs
156  log_info('MONITOR_setup',*) 'Monitor output interval [step] : ', monitor_step_interval
157  log_info('MONITOR_setup',*) 'Use deviation from first step? : ', monitor_usedeviation
158  endif
159 
160  allocate( monitor_items(monitor_nreqs) )
161 
162  rewind(io_fid_conf)
163  do n = 1, monitor_nreqs
164  ! set default
165  name = 'unknown'
166 
167  read(io_fid_conf,nml=monitor_item,iostat=ierr)
168  if( ierr /= 0 ) exit
169 
170  if ( io_fid_nml /= io_fid_log ) then
171  log_nml(monitor_item)
172  end if
173 
174  monitor_reqs(n) = name
175  enddo
176 
177 
178  monitor_dt = dt
179 
180  return
181  end subroutine monitor_setup
182 
183  !-----------------------------------------------------------------------------
185  subroutine monitor_set_dim( &
186  KA, KS, KE, IA, IS, IE, JA, JS, JE, &
187  dim_type, dim_size, &
188  area, total_area, &
189  volume, total_volume )
190  integer, intent(in) :: ka, ks, ke
191  integer, intent(in) :: ia, is, ie
192  integer, intent(in) :: ja, js, je
193 
194  character(len=*), intent(in) :: dim_type
195  integer, intent(in) :: dim_size
196  real(rp), intent(in), optional :: area(ia,ja)
197  real(rp), intent(in), optional :: total_area
198  real(rp), intent(in), optional :: volume(ka,ia,ja)
199  real(rp), intent(in), optional :: total_volume
200 
201  integer :: n
202 
203  monitor_ndims = monitor_ndims + 1
204  n = monitor_ndims
205 
206  monitor_dims(n)%name = dim_type
207  monitor_dims(n)%dim_size = dim_size
208 
209  monitor_dims(n)%KA = ka
210  monitor_dims(n)%KS = ks
211  monitor_dims(n)%KE = ke
212  monitor_dims(n)%IA = ia
213  monitor_dims(n)%IS = is
214  monitor_dims(n)%IE = ie
215  monitor_dims(n)%JA = ja
216  monitor_dims(n)%JS = js
217  monitor_dims(n)%JE = je
218 
219  if ( dim_size >= 2 ) then
220  allocate( monitor_dims(n)%area(ia,ja) )
221  monitor_dims(n)%area(:,:) = area(:,:)
222  monitor_dims(n)%total_area = total_area
223  end if
224 
225  if ( dim_size >= 3 ) then
226  allocate( monitor_dims(n)%volume(ka,ia,ja) )
227  monitor_dims(n)%volume(:,:,:) = volume(:,:,:)
228  monitor_dims(n)%total_volume = total_volume
229  end if
230 
231  return
232  end subroutine monitor_set_dim
233 
234  !-----------------------------------------------------------------------------
236  subroutine monitor_reg( &
237  name, desc, unit, &
238  itemid, &
239  ndims, dim_type, &
240  is_tendency )
241  use scale_prc, only: &
242  prc_abort
243  implicit none
244 
245  character(len=*), intent(in) :: name
246  character(len=*), intent(in) :: desc
247  character(len=*), intent(in) :: unit
248 
249  integer, intent(out) :: itemid
250 
251  integer, intent(in), optional :: ndims
252  character(len=*), intent(in), optional :: dim_type
253  logical, intent(in), optional :: is_tendency
254 
255  integer :: n, reqid, dimid
256  !---------------------------------------------------------------------------
257 
258  !--- search existing item
259  do itemid = 1, monitor_nitems
260  if ( name == monitor_items(itemid)%name ) return ! match existing item
261  enddo
262 
263  do reqid = 1, monitor_nreqs
264  if ( name == monitor_reqs(reqid) ) then
265  monitor_nitems = monitor_nitems + 1
266  itemid = monitor_nitems
267 
268  ! new file registration
269  monitor_items(itemid)%name = name
270  monitor_items(itemid)%desc = desc
271  monitor_items(itemid)%unit = unit
272 
273  dimid = -1
274  if ( present(dim_type) ) then
275  do n = 1, monitor_ndims
276  if ( monitor_dims(n)%name == dim_type ) then
277  dimid = n
278  exit
279  end if
280  end do
281  if ( dimid < 0 ) then
282  log_error('MONITOR_reg',*) 'dim_type (', trim(dim_type), ') must be registerd by MONITOR_set_dim'
283  call prc_abort
284  end if
285  else if ( present(ndims) ) then
286  do n = 1, monitor_ndims
287  if ( monitor_dims(n)%dim_size == ndims ) then
288  dimid = n
289  exit
290  end if
291  end do
292  if ( dimid == -1 ) then
293  log_error('MONITOR_reg','(a,i1,a)') 'dim_type of ', ndims, 'D must be registerd with MONITOR_set_dim'
294  call prc_abort
295  end if
296  else
297  ! ndims = 3 is assumed as default
298  do n = 1, monitor_ndims
299  if ( monitor_dims(n)%dim_size == 3 ) then
300  dimid = n
301  exit
302  end if
303  end do
304  if ( dimid == -1 ) then
305  log_error('MONITOR_reg',*) 'dim_type or ndims must be specified'
306  call prc_abort
307  end if
308  end if
309 
310  monitor_items(itemid)%dimid = dimid
311 
312  monitor_items(itemid)%var = 0.0_dp
313  monitor_items(itemid)%var0 = 0.0_dp
314  monitor_items(itemid)%first = .true.
315  if ( present(is_tendency) ) then
316  monitor_items(itemid)%tendency = is_tendency
317  else
318  monitor_items(itemid)%tendency = .false.
319  end if
320 
321  log_newline
322  log_info('MONOTOR_reg','(A,I3)') ' Item registration No.= ', itemid
323  log_info_cont(*) 'Name : ', trim(monitor_items(itemid)%name)
324  log_info_cont(*) 'Description : ', trim(monitor_items(itemid)%desc)
325  log_info_cont(*) 'Unit : ', trim(monitor_items(itemid)%unit)
326  log_info_cont(*) 'Dimension type : ', trim(monitor_dims(monitor_items(itemid)%dimid)%name)
327  log_info_cont(*) 'Integ. with dt? : ', monitor_items(itemid)%tendency
328 
329  return
330  end if
331  end do
332 
333  itemid = -1 ! not found
334 
335  return
336  end subroutine monitor_reg
337 
338  !-----------------------------------------------------------------------------
340  subroutine monitor_put_2d( &
341  itemid, var )
342  use scale_statistics, only: &
343  statistics_total
344  implicit none
345  integer, intent(in) :: itemid
346  real(RP), intent(in) :: var(:,:)
347 
348  integer :: dimid
349  real(DP) :: total
350  !---------------------------------------------------------------------------
351 
352  if( itemid <= 0 ) return
353 
354  dimid = monitor_items(itemid)%dimid
355 
356  call statistics_total( monitor_dims(dimid)%IA, monitor_dims(dimid)%IS, monitor_dims(dimid)%IE, &
357  monitor_dims(dimid)%JA, monitor_dims(dimid)%JS, monitor_dims(dimid)%JE, &
358  var(:,:), monitor_items(itemid)%name, & ! (in)
359  monitor_dims(dimid)%area(:,:), monitor_dims(dimid)%total_area, & ! (in)
360  log_suppress = .true., global = monitor_global_sum, & ! (in)
361  sum = total ) ! (out)
362 
363  if ( monitor_items(itemid)%tendency ) then
364  if ( monitor_items(itemid)%first ) then
365  monitor_items(itemid)%var = 0.0_rp
366  monitor_items(itemid)%first = .false.
367  else
368  monitor_items(itemid)%var = monitor_items(itemid)%var + total * monitor_dt ! integrate by last put
369  endif
370  else
371  if ( monitor_usedeviation ) then
372  if ( monitor_items(itemid)%first ) then
373  monitor_items(itemid)%var = 0.0_rp
374  monitor_items(itemid)%var0 = total
375  monitor_items(itemid)%first = .false.
376  else
377  monitor_items(itemid)%var = total - monitor_items(itemid)%var0 ! overwrite by last put
378  endif
379  else
380  monitor_items(itemid)%var = total ! overwrite by last put
381  endif
382  endif
383 
384  return
385  end subroutine monitor_put_2d
386 
387  !-----------------------------------------------------------------------------
389  subroutine monitor_put_3d( &
390  itemid, var )
391  use scale_statistics, only: &
392  statistics_total
393  implicit none
394 
395  integer, intent(in) :: itemid
396  real(RP), intent(in) :: var(:,:,:)
397 
398  integer :: dimid
399 
400  real(DP) :: total
401  !---------------------------------------------------------------------------
402 
403  if( itemid <= 0 ) return
404 
405  dimid = monitor_items(itemid)%dimid
406 
407 
408  call statistics_total( monitor_dims(dimid)%KA, monitor_dims(dimid)%KS, monitor_dims(dimid)%KE, &
409  monitor_dims(dimid)%IA, monitor_dims(dimid)%IS, monitor_dims(dimid)%IE, &
410  monitor_dims(dimid)%JA, monitor_dims(dimid)%JS, monitor_dims(dimid)%JE, &
411  var(:,:,:), monitor_items(itemid)%name, & ! (in)
412  monitor_dims(dimid)%volume(:,:,:), monitor_dims(dimid)%total_volume, & ! (in)
413  log_suppress = .true., global = monitor_global_sum, & ! (in)
414  sum = total ) ! (out)
415 
416  if ( monitor_items(itemid)%tendency ) then
417  if ( monitor_items(itemid)%first ) then
418  monitor_items(itemid)%var = total * monitor_dt ! first put
419  monitor_items(itemid)%first = .false.
420  else
421  monitor_items(itemid)%var = monitor_items(itemid)%var + total * monitor_dt ! integrate by last put
422  endif
423  else
424  if ( monitor_usedeviation ) then
425  if ( monitor_items(itemid)%first ) then
426  monitor_items(itemid)%var = 0.0_rp
427  monitor_items(itemid)%var0 = total
428  monitor_items(itemid)%first = .false.
429  else
430  monitor_items(itemid)%var = total - monitor_items(itemid)%var0 ! overwrite by last put
431  endif
432  else
433  monitor_items(itemid)%var = total ! overwrite by last put
434  endif
435  endif
436 
437  return
438  end subroutine monitor_put_3d
439 
440  !-----------------------------------------------------------------------------
442  subroutine monitor_in_2d( &
443  var, &
444  name, desc, unit, &
445  ndims, dim_type, &
446  is_tendency )
447  implicit none
448 
449  real(RP), intent(in) :: var(:,:)
450  character(len=*), intent(in) :: name
451  character(len=*), intent(in) :: desc
452  character(len=*), intent(in) :: unit
453 
454  integer, intent(in), optional :: ndims
455  character(len=*), intent(in), optional :: dim_type
456  logical, intent(in), optional :: is_tendency
457 
458  integer :: itemid
459  !---------------------------------------------------------------------------
460 
461  call monitor_reg( name, desc, unit, & ! (in)
462  itemid, & ! (out)
463  ndims=ndims, dim_type=dim_type, & ! (in)
464  is_tendency=is_tendency ) ! (in)
465  call monitor_put( itemid, var(:,:) )
466 
467  return
468  end subroutine monitor_in_2d
469 
470  !-----------------------------------------------------------------------------
472  subroutine monitor_in_3d( &
473  var, &
474  name, desc, unit, &
475  ndims, dim_type, &
476  is_tendency )
477  implicit none
478 
479  real(RP), intent(in) :: var(:,:,:)
480  character(len=*), intent(in) :: name
481  character(len=*), intent(in) :: desc
482  character(len=*), intent(in) :: unit
483 
484  integer, intent(in), optional :: ndims
485  character(len=*), intent(in), optional :: dim_type
486  logical, intent(in), optional :: is_tendency
487 
488  integer :: itemid
489  !---------------------------------------------------------------------------
490 
491  call monitor_reg( name, desc, unit, & ! (in)
492  itemid, & ! (out)
493  ndims=ndims, dim_type=dim_type, & ! (in)
494  is_tendency=is_tendency ) ! (in)
495  call monitor_put( itemid, var(:,:,:) )
496 
497  return
498  end subroutine monitor_in_3d
499 
500  !-----------------------------------------------------------------------------
502  subroutine monitor_write( memo, nowstep )
503  implicit none
504  character(len=*), intent(in) :: memo
505  integer , intent(in) :: nowstep
506 
507  logical, save :: firsttime = .true.
508 
509  integer :: n
510  !---------------------------------------------------------------------------
511 
512  if( monitor_nitems == 0 ) return
513 
514  call prof_rapstart('FILE_O_ASCII', 2)
515 
516  if (firsttime) then
517  firsttime = .false.
518  call monitor_writeheader
519  endif
520 
521  if ( monitor_fid > 0 ) then
522 
523  if ( mod(nowstep-1,monitor_step_interval) == 0 ) then
524  log_progress(*) 'output monitor'
525 
526  write(monitor_fid,'(A,i7,A,A4,A)',advance='no') 'STEP=',nowstep,' (',memo,')'
527  do n = 1, monitor_nitems
528  write(monitor_fid,'(A,ES15.8)',advance='no') ' ', monitor_items(n)%var
529  enddo
530  write(monitor_fid,*)
531  endif
532 
533  endif
534 
535  call prof_rapend ('FILE_O_ASCII', 2)
536 
537  return
538  end subroutine monitor_write
539 
540  !-----------------------------------------------------------------------------
542  subroutine monitor_writeheader
543  use scale_prc, only: &
544  prc_abort, &
545  prc_myrank, &
547  implicit none
548 
549  character(len=H_LONG) :: fname
550 
551  logical :: monitor_l
552  integer :: ierr
553  integer :: n
554  !---------------------------------------------------------------------------
555 
556  log_newline
557  log_info('MONITOR_writeheader',*) 'Output item list '
558  log_info_cont(*) 'Number of monitor item :', monitor_nreqs
559  log_info_cont('(1x,2A)') 'NAME :description ', &
560  ':UNIT :dimension_type'
561  log_info_cont('(1x,2A)') '=======================================================================', &
562  '==============================='
563  do n = 1, monitor_nitems
564  log_info_cont('(1x,A24,A48,A16,A16)') monitor_items(n)%name, monitor_items(n)%desc, monitor_items(n)%unit, monitor_dims(monitor_items(n)%dimid)%name
565  enddo
566  log_info_cont('(1x,2A)') '=======================================================================', &
567  '==============================='
568 
569  if ( prc_ismaster ) then ! master node
570  monitor_l = .true.
571  else
572  monitor_l = io_log_allnode .and. ( .not. monitor_global_sum )
573  endif
574 
575  if ( monitor_l ) then
576 
577  !--- Open logfile
578  monitor_fid = io_get_available_fid()
579  if ( monitor_global_sum ) then
580  fname = trim(monitor_out_basename) // '.peall'
581  else
582  call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
583  end if
584  open( unit = monitor_fid, &
585  file = trim(fname), &
586  form = 'formatted', &
587  iostat = ierr )
588  if ( ierr /= 0 ) then
589  log_error('MONITOR_writeheader',*) 'File open error! :', trim(fname)
590  call prc_abort
591  endif
592 
593  log_newline
594  log_info('MONITOR_writeheader',*) 'Open ASCII file for monitor, name : ', trim(fname)
595 
596  write(monitor_fid,'(A)',advance='no') ' '
597  do n = 1, monitor_nitems
598  write(monitor_fid,'(A16)',advance='no') monitor_items(n)%name
599  enddo
600  write(monitor_fid,*)
601 
602  endif
603 
604  return
605  end subroutine monitor_writeheader
606 
607  !-----------------------------------------------------------------------------
609  subroutine monitor_finalize
610  use scale_prc, only: &
611  prc_myrank
612  implicit none
613 
614  character(len=H_LONG) :: fname
615 
616  integer :: n
617  !---------------------------------------------------------------------------
618 
619  if ( monitor_fid > 0 ) then
620  call io_make_idstr(fname,trim(monitor_out_basename),'pe',prc_myrank)
621 
622  log_newline
623  log_info('MONITOR_finalize',*) 'Close ASCII file for monitor, name : ', trim(fname)
624 
625  close(monitor_fid)
626  endif
627 
628  do n = 1, monitor_ndims
629  if ( monitor_dims(n)%dim_size >= 2 ) deallocate( monitor_dims(n)%area )
630  if ( monitor_dims(n)%dim_size >= 3 ) deallocate( monitor_dims(n)%volume )
631  end do
632  monitor_ndims = 0
633 
634  if ( allocated(monitor_items) ) deallocate( monitor_items )
635  monitor_nitems = 0
636 
637  return
638  end subroutine monitor_finalize
639 
640 end module scale_monitor
scale_statistics
module Statistics
Definition: scale_statistics.F90:11
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_monitor::monitor_put_3d
subroutine monitor_put_3d(itemid, var)
Put total value to the monitor buffer.
Definition: scale_monitor.F90:391
scale_monitor::monitor_write
subroutine, public monitor_write(memo, nowstep)
Flush monitor buffer to formatted file.
Definition: scale_monitor.F90:503
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level, disable_barrier)
Start raptime.
Definition: scale_prof.F90:159
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:90
scale_io::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_io.F90:321
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_monitor::monitor_set_dim
subroutine, public monitor_set_dim(KA, KS, KE, IA, IS, IE, JA, JS, JE, dim_type, dim_size, area, total_area, volume, total_volume)
Set area and volume.
Definition: scale_monitor.F90:190
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
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:57
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_monitor::monitor_reg
subroutine, public monitor_reg(name, desc, unit, itemid, ndims, dim_type, is_tendency)
Search existing item, or matching check between requested and registered item.
Definition: scale_monitor.F90:241
scale_monitor::monitor_put_2d
subroutine monitor_put_2d(itemid, var)
Put total value to the monitor buffer.
Definition: scale_monitor.F90:342
scale_monitor::monitor_in_2d
subroutine monitor_in_2d(var, name, desc, unit, ndims, dim_type, is_tendency)
Wrapper routine of MONITOR_reg+MONITOR_put.
Definition: scale_monitor.F90:447
scale_monitor::monitor_finalize
subroutine, public monitor_finalize
Close file.
Definition: scale_monitor.F90:610
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level, disable_barrier)
Save raptime.
Definition: scale_prof.F90:217
scale_io::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_io.F90:58
scale_monitor::monitor_setup
subroutine, public monitor_setup(dt)
Setup.
Definition: scale_monitor.F90:105
scale_io::io_log_allnode
logical, public io_log_allnode
output log for each node?
Definition: scale_io.F90:66
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:56
scale_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:91
scale_io::io_make_idstr
subroutine, public io_make_idstr(outstr, instr, ext, rank, isrgn)
generate process specific filename
Definition: scale_io.F90:367
scale_monitor
module MONITOR
Definition: scale_monitor.F90:12