37 module procedure monitor_in_3d
38 end interface monitor_in
43 end interface monitor_put
53 private :: monitor_writeheader
59 integer :: MONITOR_FID = -1
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.
66 real(DP) :: MONITOR_dt
68 integer,
parameter :: MONITOR_req_max = 1000
69 integer :: MONITOR_nreqs = 0
70 character(len=H_SHORT) :: MONITOR_reqs(MONITOR_req_max)
73 character(len=H_SHORT) :: name
74 character(len=H_MID) :: desc
75 character(len=H_SHORT) :: unit
82 integer :: MONITOR_nitems = 0
83 type(item),
allocatable :: MONITOR_items(:)
86 character(len=H_SHORT) :: name
91 real(RP),
allocatable :: area(:,:)
92 real(RP) :: total_area
93 real(RP),
allocatable :: volume(:,:,:)
94 real(RP) :: total_volume
96 integer,
parameter :: MONITOR_dim_max = 30
97 integer :: MONITOR_ndims = 0
98 type(dim_type) :: MONITOR_dims(MONITOR_dim_max)
109 real(dp),
intent(in) :: dt
111 namelist / param_monitor / &
112 monitor_out_basename, &
113 monitor_usedeviation, &
114 monitor_global_sum, &
115 monitor_step_interval
117 character(len=H_SHORT) :: name
119 namelist / monitor_item / &
127 log_info(
"MONITOR_setup",*)
'Setup'
133 log_info(
'MONITOR_setup',*)
'Not found namelist. Default used.'
134 elseif( ierr > 0 )
then
135 log_error(
'MONITOR_setup',*)
'Not appropriate names in namelist PARAM_MONITOR. Check!'
138 log_nml(param_monitor)
142 do n = 1, monitor_req_max
146 monitor_nreqs = n - 1
148 if ( monitor_nreqs > monitor_req_max )
then
149 log_error(
'MONITOR_setup',*)
'request of monitor file is exceed! n >', monitor_req_max
151 elseif( monitor_nreqs == 0 )
then
152 log_info(
'MONITOR_setup',*)
'No monitor file specified.'
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
160 allocate( monitor_items(monitor_nreqs) )
163 do n = 1, monitor_nreqs
171 log_nml(monitor_item)
174 monitor_reqs(n) = name
186 KA, KS, KE, IA, IS, IE, JA, JS, JE, &
187 dim_type, dim_size, &
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
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
203 monitor_ndims = monitor_ndims + 1
206 monitor_dims(n)%name = dim_type
207 monitor_dims(n)%dim_size = dim_size
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
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
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
245 character(len=*),
intent(in) :: name
246 character(len=*),
intent(in) :: desc
247 character(len=*),
intent(in) :: unit
249 integer,
intent(out) :: itemid
251 integer,
intent(in),
optional :: ndims
252 character(len=*),
intent(in),
optional :: dim_type
253 logical,
intent(in),
optional :: is_tendency
255 integer :: n, reqid, dimid
259 do itemid = 1, monitor_nitems
260 if ( name == monitor_items(itemid)%name )
return
263 do reqid = 1, monitor_nreqs
264 if ( name == monitor_reqs(reqid) )
then
265 monitor_nitems = monitor_nitems + 1
266 itemid = monitor_nitems
269 monitor_items(itemid)%name = name
270 monitor_items(itemid)%desc = desc
271 monitor_items(itemid)%unit = unit
274 if (
present(dim_type) )
then
275 do n = 1, monitor_ndims
276 if ( monitor_dims(n)%name == dim_type )
then
281 if ( dimid < 0 )
then
282 log_error(
'MONITOR_reg',*)
'dim_type (', trim(dim_type),
') must be registerd by MONITOR_set_dim'
285 else if (
present(ndims) )
then
286 do n = 1, monitor_ndims
287 if ( monitor_dims(n)%dim_size == ndims )
then
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'
298 do n = 1, monitor_ndims
299 if ( monitor_dims(n)%dim_size == 3 )
then
304 if ( dimid == -1 )
then
305 log_error(
'MONITOR_reg',*)
'dim_type or ndims must be specified'
310 monitor_items(itemid)%dimid = dimid
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
318 monitor_items(itemid)%tendency = .false.
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
345 integer,
intent(in) :: itemid
346 real(RP),
intent(in) :: var(:,:)
352 if( itemid <= 0 )
return
354 dimid = monitor_items(itemid)%dimid
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, &
359 monitor_dims(dimid)%area(:,:), monitor_dims(dimid)%total_area, &
360 log_suppress = .true., global = monitor_global_sum, &
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.
368 monitor_items(itemid)%var = monitor_items(itemid)%var + total * monitor_dt
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.
377 monitor_items(itemid)%var = total - monitor_items(itemid)%var0
380 monitor_items(itemid)%var = total
395 integer,
intent(in) :: itemid
396 real(RP),
intent(in) :: var(:,:,:)
403 if( itemid <= 0 )
return
405 dimid = monitor_items(itemid)%dimid
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, &
412 monitor_dims(dimid)%volume(:,:,:), monitor_dims(dimid)%total_volume, &
413 log_suppress = .true., global = monitor_global_sum, &
416 if ( monitor_items(itemid)%tendency )
then
417 if ( monitor_items(itemid)%first )
then
418 monitor_items(itemid)%var = total * monitor_dt
419 monitor_items(itemid)%first = .false.
421 monitor_items(itemid)%var = monitor_items(itemid)%var + total * monitor_dt
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.
430 monitor_items(itemid)%var = total - monitor_items(itemid)%var0
433 monitor_items(itemid)%var = total
449 real(RP),
intent(in) :: var(:,:)
450 character(len=*),
intent(in) :: name
451 character(len=*),
intent(in) :: desc
452 character(len=*),
intent(in) :: unit
454 integer,
intent(in),
optional :: ndims
455 character(len=*),
intent(in),
optional :: dim_type
456 logical,
intent(in),
optional :: is_tendency
463 ndims=ndims, dim_type=dim_type, &
464 is_tendency=is_tendency )
465 call monitor_put( itemid, var(:,:) )
472 subroutine monitor_in_3d( &
479 real(RP),
intent(in) :: var(:,:,:)
480 character(len=*),
intent(in) :: name
481 character(len=*),
intent(in) :: desc
482 character(len=*),
intent(in) :: unit
484 integer,
intent(in),
optional :: ndims
485 character(len=*),
intent(in),
optional :: dim_type
486 logical,
intent(in),
optional :: is_tendency
493 ndims=ndims, dim_type=dim_type, &
494 is_tendency=is_tendency )
495 call monitor_put( itemid, var(:,:,:) )
498 end subroutine monitor_in_3d
504 character(len=*),
intent(in) :: memo
505 integer ,
intent(in) :: nowstep
507 logical,
save :: firsttime = .true.
512 if( monitor_nitems == 0 )
return
518 call monitor_writeheader
521 if ( monitor_fid > 0 )
then
523 if ( mod(nowstep-1,monitor_step_interval) == 0 )
then
524 log_progress(*)
'output monitor'
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
542 subroutine monitor_writeheader
549 character(len=H_LONG) :: fname
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
566 log_info_cont(
'(1x,2A)')
'=======================================================================', &
567 '==============================='
575 if ( monitor_l )
then
579 if ( monitor_global_sum )
then
580 fname = trim(monitor_out_basename) //
'.peall'
584 open( unit = monitor_fid, &
585 file = trim(fname), &
586 form =
'formatted', &
588 if ( ierr /= 0 )
then
589 log_error(
'MONITOR_writeheader',*)
'File open error! :', trim(fname)
594 log_info(
'MONITOR_writeheader',*)
'Open ASCII file for monitor, name : ', trim(fname)
596 write(monitor_fid,
'(A)',advance=
'no')
' '
597 do n = 1, monitor_nitems
598 write(monitor_fid,
'(A16)',advance=
'no') monitor_items(n)%name
605 end subroutine monitor_writeheader
614 character(len=H_LONG) :: fname
619 if ( monitor_fid > 0 )
then
623 log_info(
'MONITOR_finalize',*)
'Close ASCII file for monitor, name : ', trim(fname)
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 )
634 if (
allocated(monitor_items) )
deallocate( monitor_items )