19 use scale_prc,
only: &
40 module procedure :: meshfield_statistics_detail_1d
41 module procedure :: meshfield_statistics_detail_2d
42 module procedure :: meshfield_statistics_detail_3d
47 module procedure :: meshfield_statistics_maxmin_1d
48 module procedure :: meshfield_statistics_maxmin_2d
49 module procedure :: meshfield_statistics_maxmin_3d
54 module procedure :: meshfield_statistics_total_1d
55 module procedure :: meshfield_statistics_total_2d
56 module procedure :: meshfield_statistics_total_3d
69 type :: meshfield_statistics_base
70 logical :: use_globalcomm
71 integer :: comm_datatype
72 end type meshfield_statistics_base
78 type(MeshField_statistics_base),
private :: base
86 use scale_prc,
only: &
90 logical :: use_globalcomm = .false.
91 namelist / param_meshfield_statistics / &
98 log_info(
"MeshField_statistics_setup",*)
'Setup'
102 read(io_fid_conf,nml=param_meshfield_statistics,iostat=ierr)
104 log_info(
"MeshField_statistics_setup",*)
'Not found namelist. Default used.'
105 elseif( ierr > 0 )
then
106 log_error(
"MeshField_statistics_setup",*)
'Not appropriate names in namelist PARAM_MeshField_statistics. Check!'
109 log_nml(param_meshfield_statistics)
111 base%use_globalcomm = use_globalcomm
113 if ( base%use_globalcomm )
then
114 log_info_cont(*)
'=> The total is calculated for the global domain.'
116 log_info_cont(*)
'=> The total is calculated for the local domain.'
119 if ( rp == kind(0.d0) )
then
120 base%comm_datatype = mpi_double_precision
121 elseif( rp == kind(0.0) )
then
122 base%comm_datatype = mpi_real
124 log_error(
"MeshField_statistics_setup",*)
'precision is not supportd'
134 subroutine meshfield_statistics_total_1d( field, & ! (in)
135 log_suppress, global, &
141 logical,
intent(in),
optional :: log_suppress
142 logical,
intent(in),
optional :: global
143 real(RP),
intent(out),
optional :: mean
144 real(DP),
intent(out),
optional :: sum
150 call calculate_statval( field, field%mesh%lcmesh_list(:), &
153 call statistics_total_core( &
154 field%varname, statval, total, &
155 log_suppress, global, &
159 end subroutine meshfield_statistics_total_1d
164 subroutine meshfield_statistics_total_2d( field, & ! (in)
165 log_suppress, global, &
171 logical,
intent(in),
optional :: log_suppress
172 logical,
intent(in),
optional :: global
173 real(RP),
intent(out),
optional :: mean
174 real(DP),
intent(out),
optional :: sum
180 call calculate_statval( field, field%mesh%lcmesh_list(:), &
183 call statistics_total_core( &
184 field%varname, statval, total, &
185 log_suppress, global, &
189 end subroutine meshfield_statistics_total_2d
194 subroutine meshfield_statistics_total_3d( field, & ! (in)
195 log_suppress, global, &
201 logical,
intent(in),
optional :: log_suppress
202 logical,
intent(in),
optional :: global
203 real(RP),
intent(out),
optional :: mean
204 real(DP),
intent(out),
optional :: sum
210 call calculate_statval( field, field%mesh%lcmesh_list(:), &
213 call statistics_total_core( &
214 field%varname, statval, total, &
215 log_suppress, global, &
219 end subroutine meshfield_statistics_total_3d
227 subroutine meshfield_statistics_maxmin_1d( field_list, & ! (in)
228 log_suppress, global, &
234 logical,
intent(in),
optional :: log_suppress
235 logical,
intent(in),
optional :: global
236 real(RP),
intent(out),
optional :: maxval(size(field_list))
237 real(RP),
intent(out),
optional :: minval(size(field_list))
239 real(RP) :: statval_l( size(field_list),2)
240 integer :: statidx_l(3,size(field_list),2)
244 va =
size(field_list)
245 call search_maxmin_local( &
246 va, field_list, field_list(1)%mesh%lcmesh_list, &
247 statval_l, statidx_l )
249 call statistics_detail_core( &
250 va, field_list, statval_l, statidx_l, .not. global, log_suppress, &
254 end subroutine meshfield_statistics_maxmin_1d
257 subroutine meshfield_statistics_detail_1d( field_list, local )
261 logical,
intent(in),
optional :: local
263 real(RP) :: statval_l( size(field_list),2)
264 integer :: statidx_l(3,size(field_list),2)
269 log_info(
"MeshField_STATISTICS_detail_1D",*)
'Variable Statistics '
271 va =
size(field_list)
272 call search_maxmin_local( &
273 va, field_list, field_list(1)%mesh%lcmesh_list, &
274 statval_l, statidx_l )
276 call statistics_detail_core( &
277 va, field_list, statval_l, statidx_l, local )
282 end subroutine meshfield_statistics_detail_1d
286 subroutine meshfield_statistics_maxmin_2d( field_list, & ! (in)
287 log_suppress, global, &
293 logical,
intent(in),
optional :: log_suppress
294 logical,
intent(in),
optional :: global
295 real(RP),
intent(out),
optional :: maxval(size(field_list))
296 real(RP),
intent(out),
optional :: minval(size(field_list))
298 real(RP) :: statval_l( size(field_list),2)
299 integer :: statidx_l(3,size(field_list),2)
303 va =
size(field_list)
304 call search_maxmin_local( &
305 va, field_list, field_list(1)%mesh%lcmesh_list, &
306 statval_l, statidx_l )
308 call statistics_detail_core( &
309 va, field_list, statval_l, statidx_l, .not. global, log_suppress, &
313 end subroutine meshfield_statistics_maxmin_2d
316 subroutine meshfield_statistics_detail_2d( field_list, local )
320 logical,
intent(in),
optional :: local
322 real(RP) :: statval_l( size(field_list),2)
323 integer :: statidx_l(3,size(field_list),2)
328 log_info(
"MeshField_STATISTICS_detail_2D",*)
'Variable Statistics '
330 va =
size(field_list)
331 call search_maxmin_local( &
332 va, field_list, field_list(1)%mesh%lcmesh_list, &
333 statval_l, statidx_l )
335 call statistics_detail_core( &
336 va, field_list, statval_l, statidx_l, local )
341 end subroutine meshfield_statistics_detail_2d
346 subroutine meshfield_statistics_maxmin_3d( field_list, & ! (in)
347 log_suppress, global, &
353 logical,
intent(in),
optional :: log_suppress
354 logical,
intent(in),
optional :: global
355 real(RP),
intent(out),
optional :: maxval(size(field_list))
356 real(DP),
intent(out),
optional :: minval(size(field_list))
358 real(RP) :: statval_l( size(field_list),2)
359 integer :: statidx_l(3,size(field_list),2)
363 va =
size(field_list)
364 call search_maxmin_local( &
365 va, field_list, field_list(1)%mesh%lcmesh_list, &
366 statval_l, statidx_l )
368 call statistics_detail_core( &
369 va, field_list, statval_l, statidx_l, .not. global, log_suppress, &
373 end subroutine meshfield_statistics_maxmin_3d
376 subroutine meshfield_statistics_detail_3d( field_list, local )
380 logical,
intent(in),
optional :: local
382 real(RP) :: statval_l( size(field_list),2)
383 integer :: statidx_l(3,size(field_list),2)
388 log_info(
"MeshField_STATISTICS_detail_3D",*)
'Variable Statistics '
390 va =
size(field_list)
391 call search_maxmin_local( &
392 va, field_list, field_list(1)%mesh%lcmesh_list, &
393 statval_l, statidx_l )
395 call statistics_detail_core( &
396 va, field_list, statval_l, statidx_l, local )
401 end subroutine meshfield_statistics_detail_3d
406 subroutine search_maxmin_local( VA, field_list, lcmesh_list, &
407 statval_l, statidx_l )
410 integer,
intent(in) :: VA
413 real(RP),
intent(out) :: statval_l ( VA,2)
414 integer,
intent(out) :: statidx_l (3,VA,2)
425 do n=1,
size(lcmesh_list)
426 lcmesh => lcmesh_list(n)
427 refelem => lcmesh%refElem
429 call field_list(v)%GetLocalMeshField(n, lcfield)
431 statval_l( v,:) = lcfield%val(1,lcmesh%NeS)
433 statidx_l(2,v,:) = lcmesh%NeS
436 do ke=lcmesh%NeS, lcmesh%NeE
438 if ( lcfield%val(p,ke) > statval_l(v,1) )
then
439 statval_l( v,1) = lcfield%val(p,ke)
440 statidx_l(:,v,1) = (/ p, ke, n /)
442 if ( lcfield%val(p,ke) < statval_l(v,2) )
then
443 statval_l( v,2) = lcfield%val(p,ke)
444 statidx_l(:,v,2) = (/ p, ke, n /)
452 end subroutine search_maxmin_local
455 subroutine statistics_detail_core( &
456 VA, field_list, statval_l, statidx_l, & ! (in)
457 local, log_supress, &
460 use scale_prc,
only: &
464 integer,
intent(in) :: VA
466 real(DP),
intent(in) :: statval_l( VA,2)
467 integer,
intent(in) :: statidx_l(3,VA,2)
468 logical,
intent(in),
optional :: local
469 logical,
intent(in),
optional :: log_supress
470 real(RP),
intent(out),
optional :: maxval(VA)
471 real(RP),
intent(out),
optional :: minval(VA)
473 real(RP) :: statval ( VA,2,0:PRC_nprocs-1)
474 integer :: statidx (3,VA,2,0:PRC_nprocs-1)
475 real(RP) :: allstatval(VA,2)
476 integer :: allstatidx(VA,2)
477 logical :: do_globalcomm
486 do_globalcomm = base%use_globalcomm
487 if (
present(local) ) do_globalcomm = ( .not. local )
489 if (
present(log_supress) )
then
490 supress_ = log_supress
495 if ( do_globalcomm )
then
496 call prof_rapstart(
'COMM_Bcast', 2)
498 call mpi_allgather( statval_l(:,:), &
500 base%comm_datatype, &
503 base%comm_datatype, &
504 prc_local_comm_world, &
507 call mpi_allgather( statidx_l(:,:,:), &
513 prc_local_comm_world, &
516 call prof_rapend (
'COMM_Bcast', 2)
519 allstatval(v,1) = statval(v,1,0)
520 allstatval(v,2) = statval(v,2,0)
522 do p = 1, prc_nprocs-1
523 if ( statval(v,1,p) > allstatval(v,1) )
then
524 allstatval(v,1) = statval(v,1,p)
527 if ( statval(v,2,p) < allstatval(v,2) )
then
528 allstatval(v,2) = statval(v,2,p)
532 if ( .not. supress_ )
then
533 log_info_cont(*)
'[', trim(field_list(v)%varname),
']'
534 log_info_cont(
'(1x,A,ES17.10,A,4(I5,A))')
' MAX =', &
535 allstatval(v,1),
' (rank=', &
536 allstatidx(v,1),
'; ', &
537 statidx(1,v,1,allstatidx(v,1)),
',', &
538 statidx(2,v,1,allstatidx(v,1)),
',', &
539 statidx(3,v,1,allstatidx(v,1)),
')'
540 log_info_cont(
'(1x,A,ES17.10,A,4(I5,A))')
' MIN =', &
541 allstatval(v,2),
' (rank=', &
542 allstatidx(v,2),
'; ', &
543 statidx(1,v,2,allstatidx(v,2)),
',', &
544 statidx(2,v,2,allstatidx(v,2)),
',', &
545 statidx(3,v,2,allstatidx(v,2)),
')'
548 if (
present(maxval) ) maxval(v) = allstatval(v,1)
549 if (
present(minval) ) minval(v) = allstatval(v,2)
554 if ( .not. supress_ )
then
555 log_info_cont(*)
'[', trim(field_list(v)%varname),
']'
556 log_info_cont(
'(1x,A,ES17.10,A,3(I5,A))')
'MAX = ', &
557 statval_l( v,1),
' (', &
558 statidx_l(1,v,1),
',', &
559 statidx_l(2,v,1),
',', &
561 log_info_cont(
'(1x,A,ES17.10,A,3(I5,A))')
'MIN = ', &
562 statval_l( v,2),
' (', &
563 statidx_l(1,v,2),
',', &
564 statidx_l(2,v,2),
',', &
567 if (
present(maxval) ) maxval(v) = statval_l(v,1)
568 if (
present(minval) ) minval(v) = statval_l(v,2)
573 end subroutine statistics_detail_core
578 subroutine calculate_statval( field, lcmesh_list, &
585 real(DP),
intent(out) :: statval
586 real(DP),
intent(out) :: total
592 real(DP) :: statval_lc
602 do n=1,
size(lcmesh_list)
603 lcmesh => lcmesh_list(n)
604 refelem => lcmesh%refElem
605 call field%GetLocalMeshField(n, lcfield)
610 do ke=lcmesh%NeS, lcmesh%NeE
612 weight = lcmesh%J(p,ke) * lcmesh%Gsqrt(p,ke) * refelem%IntWeight_lgl(p)
613 total_lc = total_lc + weight
614 statval_lc = statval_lc + weight * lcfield%val(p,ke)
617 total = total + total_lc
618 statval = statval + statval_lc
622 end subroutine calculate_statval
625 subroutine statistics_total_core( &
626 varname, statval, total, &
630 use scale_prc,
only: &
633 use scale_const,
only: &
639 character(len=*),
intent(in) :: varname
640 real(DP),
intent(in) :: statval
641 real(DP),
intent(in) :: total
642 logical,
intent(in),
optional :: log_suppress
643 logical,
intent(in),
optional :: global
644 real(RP),
intent(out),
optional :: mean
645 real(DP),
intent(out),
optional :: sum
647 real(DP) :: sendbuf(2), recvbuf(2)
648 real(DP) :: sum_, mean_
650 logical :: suppress_, global_
654 if ( .NOT. ( statval > -1.0_dp .OR. statval < 1.0_dp ) )
then
655 log_error(
"MeshField_STATISTICS_total",*)
'NaN is detected for ', trim(varname),
' in rank ', prc_myrank
659 if (
present(log_suppress) )
then
660 suppress_ = log_suppress
665 if (
present(global) )
then
668 global_ = base%use_globalcomm
672 call prof_rapstart(
'COMM_Allreduce', 2)
676 call mpi_allreduce( sendbuf(:), recvbuf(:), &
678 mpi_double_precision, &
680 prc_local_comm_world, &
682 call prof_rapend (
'COMM_Allreduce', 2)
684 if ( recvbuf(2) < eps )
then
689 mean_ = recvbuf(1) / recvbuf(2)
692 if ( .not. suppress_ )
then
693 log_info(
"MeshField_STATISTICS_total_3D",
'(1x,A,A24,A,ES24.17)') &
694 '[', trim(varname),
'] MEAN(global) = ', mean_
697 if ( total < eps )
then
702 mean_ = statval / total
706 if ( .not. suppress_ )
then
707 log_info(
"MeshField_STATISTICS_total_3D",
'(1x,A,A24,A,ES24.17)') &
708 '[', trim(varname),
'] MEAN(local) = ', mean_
712 if (
present(mean) ) mean = mean_
713 if (
present(sum ) ) sum = sum_
716 end subroutine statistics_total_core
module FElib / Element / Base
module FElib / Mesh / Local, Base
module FElib / Data / base
module FElib / Data / base
module FElib / Data / Statistics
subroutine, public meshfield_statistics_setup()
Setup.