SCALE-RM
Data Types | Functions/Subroutines | Variables
scale_statistics Module Reference

module Statistics More...

Functions/Subroutines

subroutine, public statistics_setup
 Setup. More...
 
subroutine statistics_total_2d (IA, IS, IE, JA, JS, JE, var, varname, area, total, log_suppress, global, mean, sum)
 Calc domain sum and area-weighted mean. More...
 
subroutine statistics_total_3d (KA, KS, KE, IA, IS, IE, JA, JS, JE, var, varname, vol, total, log_suppress, global, mean, sum)
 Calc domain sum and volume-weighted mean. More...
 
subroutine statistics_horizontal_mean_2d (IA, IS, IE, JA, JS, JE, var, area, varmean)
 Calc horizontal mean value. More...
 
subroutine statistics_horizontal_mean_3d (KA, KS, KE, IA, IS, IE, JA, JS, JE, var, area, varmean)
 
subroutine statistics_horizontal_min_2d (IA, IS, IE, JA, JS, JE, var, varmin)
 Calc horizontal minimum value. More...
 
subroutine statistics_horizontal_min_3d (KA, KS, KE, IA, IS, IE, JA, JS, JE, var, varmin)
 
subroutine statistics_horizontal_max_2d (IA, IS, IE, JA, JS, JE, var, varmax)
 Calc horizontal maximum value. More...
 
subroutine statistics_horizontal_max_3d (KA, KS, KE, IA, IS, IE, JA, JS, JE, var, varmax)
 
subroutine statistics_detail_3d (KA, KS, KE, IA, IS, IE, JA, JS, JE, VA, varname, var, local)
 Search global maximum & minimum value. More...
 
subroutine statistics_detail_2d (IA, IS, IE, JA, JS, JE, VA, varname, var, local)
 

Variables

logical, public statistics_checktotal = .false.
 calc&report variable totals to logfile? More...
 

Detailed Description

module Statistics

Description
global statistics module
Author
Team SCALE
NAMELIST
  • PARAM_STATISTICS
    nametypedefault valuecomment
    STATISTICS_CHECKTOTAL logical .false. calc&report variable totals to logfile?
    STATISTICS_USE_GLOBALCOMM logical .false. calculate total with global communication?

History Output
No history output

Function/Subroutine Documentation

◆ statistics_setup()

subroutine, public scale_statistics::statistics_setup

Setup.

Definition at line 81 of file scale_statistics.F90.

81  use scale_prc, only: &
82  prc_abort
83  use scale_comm_cartesc, only: &
85  implicit none
86 
87  namelist / param_statistics / &
88  statistics_checktotal, &
89  statistics_use_globalcomm
90 
91  integer :: ierr
92  !---------------------------------------------------------------------------
93 
94  call comm_setup
95 
96  log_newline
97  log_info("STATISTICS_setup",*) 'Setup'
98 
99  !--- read namelist
100  rewind(io_fid_conf)
101  read(io_fid_conf,nml=param_statistics,iostat=ierr)
102  if( ierr < 0 ) then !--- missing
103  log_info("STATISTICS_setup",*) 'Not found namelist. Default used.'
104  elseif( ierr > 0 ) then !--- fatal error
105  log_error("STATISTICS_setup",*) 'Not appropriate names in namelist PARAM_STATISTICS. Check!'
106  call prc_abort
107  endif
108  log_nml(param_statistics)
109 
110  log_newline
111  log_info("STATISTICS_setup",*) 'Caluculate total statistics for monitoring? : ', statistics_checktotal
112  if ( statistics_use_globalcomm ) then
113  log_info_cont(*) '=> The total is calculated for the global domain.'
114  else
115  log_info_cont(*) '=> The total is calculated for the local domain.'
116  endif
117 
118  return

References scale_comm_cartesc::comm_setup(), scale_io::io_fid_conf, scale_prc::prc_abort(), and statistics_checktotal.

Referenced by mod_rm_driver::rm_driver(), and mod_rm_prep::rm_prep().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ statistics_total_2d()

subroutine scale_statistics::statistics_total_2d ( integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension(ia,ja), intent(in)  var,
character(len=*), intent(in)  varname,
real(rp), dimension(ia,ja), intent(in)  area,
real(rp), intent(in)  total,
logical, intent(in), optional  log_suppress,
logical, intent(in), optional  global,
real(rp), intent(out), optional  mean,
real(dp), intent(out), optional  sum 
)

Calc domain sum and area-weighted mean.

Parameters
[in]var3D value
[in]varnamename of item
[in]areaarea of the grid cell
[in]totaltotal area
[in]log_suppresssuppress log output
[in]globalglobal or local sum
[out]meanarea-weighted mean
[out]sumdomain sum

Definition at line 130 of file scale_statistics.F90.

130  use scale_prc, only: &
131  prc_myrank, &
132  prc_abort
133  use scale_const, only: &
134  eps => const_eps, &
135  undef => const_undef
136  implicit none
137 
138  integer, intent(in) :: IA, IS, IE
139  integer, intent(in) :: JA, JS, JE
140 
141  real(RP), intent(in) :: var(IA,JA)
142  character(len=*), intent(in) :: varname
143  real(RP), intent(in) :: area(IA,JA)
144  real(RP), intent(in) :: total
145 
146  logical, intent(in), optional :: log_suppress
147  logical, intent(in), optional :: global
148  real(RP), intent(out), optional :: mean
149  real(DP), intent(out), optional :: sum
150 
151  real(DP) :: statval
152  real(DP) :: sendbuf(2), recvbuf(2)
153  real(DP) :: sum_, mean_
154 
155  logical :: suppress_, global_
156  integer :: ierr
157  integer :: i, j
158  !---------------------------------------------------------------------------
159 
160  statval = 0.0_dp
161  if ( var(is,js) /= undef ) then
162  !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2) reduction(+:statval)
163  do j = js, je
164  do i = is, ie
165  statval = statval + var(i,j) * area(i,j)
166  end do
167  end do
168  end if
169 
170  if ( .NOT. ( statval > -1.0_dp .OR. statval < 1.0_dp ) ) then ! must be NaN
171  log_error("STATISTICS_total_2D",*) 'NaN is detected for ', trim(varname), ' in rank ', prc_myrank
172  call prc_abort
173  endif
174 
175  if ( present(log_suppress) ) then
176  suppress_ = log_suppress
177  else
178  suppress_ = .false.
179  end if
180 
181  if ( present(global) ) then
182  global_ = global
183  else
184  global_ = statistics_use_globalcomm
185  end if
186 
187  if ( global_ ) then
188  call prof_rapstart('COMM_Allreduce', 2)
189  sendbuf(1) = statval
190  sendbuf(2) = total
191  ! All reduce
192  call mpi_allreduce( sendbuf(:), recvbuf(:), &
193  2, &
194  mpi_double_precision, &
195  mpi_sum, &
196  prc_local_comm_world, &
197  ierr )
198  call prof_rapend ('COMM_Allreduce', 2)
199 
200  if ( recvbuf(2) < eps ) then
201  sum_ = undef
202  mean_ = undef
203  else
204  sum_ = recvbuf(1)
205  mean_ = recvbuf(1) / recvbuf(2)
206  end if
207  ! statistics over the all node
208  if ( .not. suppress_ ) then ! if varname is empty, suppress output
209  log_info("STATISTICS_total_2D",'(1x,A,A24,A,ES24.17)') &
210  '[', trim(varname), '] MEAN(global) = ', mean_
211  endif
212  else
213  if ( total < eps ) then
214  sum_ = undef
215  mean_ = undef
216  else
217  sum_ = statval
218  mean_ = statval / total
219  end if
220 
221  ! statistics on each node
222  if ( .not. suppress_ ) then ! if varname is empty, suppress output
223  log_info("STATISTICS_total_2D",'(1x,A,A24,A,ES24.17)') &
224  '[', trim(varname), '] MEAN(local) = ', mean_
225  endif
226  endif
227 
228  if ( present(mean) ) mean = mean_
229  if ( present(sum ) ) sum = sum_
230 
231  return

References scale_const::const_eps, scale_const::const_undef, scale_prc::prc_abort(), scale_prc::prc_myrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_total_3d()

subroutine scale_statistics::statistics_total_3d ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension(ka,ia,ja), intent(in)  var,
character(len=*), intent(in)  varname,
real(rp), dimension(ka,ia,ja), intent(in)  vol,
real(rp), intent(in)  total,
logical, intent(in), optional  log_suppress,
logical, intent(in), optional  global,
real(rp), intent(out), optional  mean,
real(dp), intent(out), optional  sum 
)

Calc domain sum and volume-weighted mean.

Parameters
[in]var3D value
[in]varnamename of item
[in]volvolume of the grid cell
[in]totaltotal volume
[in]log_suppresssuppress log output
[in]globalglobal or local sum
[out]meanvolume/area-weighted total
[out]sumdomain sum

Definition at line 243 of file scale_statistics.F90.

243  use scale_prc, only: &
244  prc_myrank, &
245  prc_abort
246  use scale_const, only: &
247  eps => const_eps , &
248  undef => const_undef
249  implicit none
250 
251  integer, intent(in) :: KA, KS, KE
252  integer, intent(in) :: IA, IS, IE
253  integer, intent(in) :: JA, JS, JE
254 
255  real(RP), intent(in) :: var(KA,IA,JA)
256  character(len=*), intent(in) :: varname
257  real(RP), intent(in) :: vol(KA,IA,JA)
258  real(RP), intent(in) :: total
259 
260  logical, intent(in), optional :: log_suppress
261  logical, intent(in), optional :: global
262  real(RP), intent(out), optional :: mean
263  real(DP), intent(out), optional :: sum
264 
265  real(DP) :: statval
266  real(DP) :: sendbuf(2), recvbuf(2)
267  real(DP) :: mean_, sum_
268 
269  logical :: suppress_, global_
270 
271  real(DP) :: work
272  integer :: ierr
273  integer :: k, i, j
274  !---------------------------------------------------------------------------
275 
276  statval = 0.0_dp
277  if ( var(ks,is,js) /= undef ) then
278  !$omp parallel do OMP_SCHEDULE_ reduction(+:statval) &
279  !$omp private(work)
280  do j = je, js, -1
281  do i = ie, is, -1
282  work = 0.0_rp
283  do k = ke, ks, -1
284  work = work + var(k,i,j) * vol(k,i,j)
285  enddo
286  statval = statval + work
287  enddo
288  enddo
289  end if
290 
291  if ( .NOT. ( statval > -1.0_dp .OR. statval < 1.0_dp ) ) then ! must be NaN
292  log_error("STATISTICS_total_3D",*) 'NaN is detected for ', trim(varname), ' in rank ', prc_myrank
293  call prc_abort
294  endif
295 
296  if ( present(log_suppress) ) then
297  suppress_ = log_suppress
298  else
299  suppress_ = .false.
300  end if
301 
302  if ( present(global) ) then
303  global_ = global
304  else
305  global_ = statistics_use_globalcomm
306  end if
307 
308  if ( global_ ) then
309  call prof_rapstart('COMM_Allreduce', 2)
310  sendbuf(1) = statval
311  sendbuf(2) = total
312  ! All reduce
313  call mpi_allreduce( sendbuf(:), recvbuf(:), &
314  2, &
315  mpi_double_precision, &
316  mpi_sum, &
317  prc_local_comm_world, &
318  ierr )
319  call prof_rapend ('COMM_Allreduce', 2)
320 
321  if ( recvbuf(2) < eps ) then
322  sum_ = undef
323  mean_ = undef
324  else
325  sum_ = recvbuf(1)
326  mean_ = recvbuf(1) / recvbuf(2)
327  end if
328  ! statistics over the all node
329  if ( .not. suppress_ ) then ! if varname is empty, suppress output
330  log_info("STATISTICS_total_3D",'(1x,A,A24,A,ES24.17)') &
331  '[', trim(varname), '] MEAN(global) = ', mean_
332  endif
333  else
334  if ( total < eps ) then
335  sum_ = undef
336  mean_ = undef
337  else
338  sum_ = statval
339  mean_ = statval / total
340  end if
341 
342  ! statistics on each node
343  if ( .not. suppress_ ) then ! if varname is empty, suppress output
344  log_info("STATISTICS_total_3D",'(1x,A,A24,A,ES24.17)') &
345  '[', trim(varname), '] MEAN(local) = ', mean_
346  endif
347  endif
348 
349  if ( present(mean) ) mean = mean_
350  if ( present(sum ) ) sum = sum_
351 
352  return

References scale_const::const_eps, scale_const::const_undef, scale_prc::prc_abort(), scale_prc::prc_myrank, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_horizontal_mean_2d()

subroutine scale_statistics::statistics_horizontal_mean_2d ( integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension (ia,ja), intent(in)  var,
real(rp), dimension(ia,ja), intent(in)  area,
real(rp), intent(out)  varmean 
)

Calc horizontal mean value.

Definition at line 361 of file scale_statistics.F90.

361  use scale_const, only: &
362  undef => const_undef
363  integer, intent(in) :: IA, IS, IE
364  integer, intent(in) :: JA, JS, JE
365  real(RP), intent(in) :: var (IA,JA)
366  real(RP), intent(in) :: area(IA,JA)
367  real(RP), intent(out) :: varmean
368 
369  real(DP) :: statval (2)
370  real(DP) :: allstatval(2)
371 
372  integer :: ierr
373  integer :: i, j
374  !---------------------------------------------------------------------------
375 
376  statval(:) = 0.0_dp
377 ! !$omp parallel do reduction(+:statval)
378  do j = js, je
379  do i = is, ie
380  if ( var(i,j) /= undef ) then
381  statval(1) = statval(1) + area(i,j) * var(i,j)
382  statval(2) = statval(2) + area(i,j)
383  endif
384  enddo
385  enddo
386 
387  call prof_rapstart('COMM_Allreduce', 2)
388  ! All reduce
389  call mpi_allreduce( statval(:), &
390  allstatval(:), &
391  2, &
392  mpi_double_precision, &
393  mpi_sum, &
394  prc_local_comm_world, &
395  ierr )
396  call prof_rapend ('COMM_Allreduce', 2)
397 
398  if ( allstatval(2) > 0.0_dp ) then
399  varmean = allstatval(1) / allstatval(2)
400  else
401  varmean = undef
402  end if
403 
404  return

References scale_const::const_undef, scale_prc::prc_local_comm_world, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_horizontal_mean_3d()

subroutine scale_statistics::statistics_horizontal_mean_3d ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension (ka,ia,ja), intent(in)  var,
real(rp), dimension( ia,ja), intent(in)  area,
real(rp), dimension(ka), intent(out)  varmean 
)

Definition at line 411 of file scale_statistics.F90.

411  use scale_const, only: &
412  undef => const_undef
413  integer, intent(in) :: KA, KS, KE
414  integer, intent(in) :: IA, IS, IE
415  integer, intent(in) :: JA, JS, JE
416 
417  real(RP), intent(in) :: var (KA,IA,JA)
418  real(RP), intent(in) :: area( IA,JA)
419  real(RP), intent(out) :: varmean(KA)
420 
421  real(DP) :: statval (2,KA)
422  real(DP) :: allstatval(2,KA)
423 
424  integer :: ierr
425  integer :: k, i, j
426  !---------------------------------------------------------------------------
427 
428  statval(:,:) = 0.0_dp
429 ! !$omp parallel do reduction(+:statval)
430  do j = js, je
431  do i = is, ie
432  do k = ks, ke
433  if ( var(k,i,j) /= undef ) then
434  statval(1,k) = statval(1,k) + area(i,j) * var(k,i,j)
435  statval(2,k) = statval(2,k) + area(i,j)
436  endif
437  enddo
438  enddo
439  enddo
440 
441  call prof_rapstart('COMM_Allreduce', 2)
442  ! All reduce
443  call mpi_allreduce( statval(:,ks:ke), &
444  allstatval(:,ks:ke), &
445  (ke-ks+1)*2, &
446  mpi_double_precision, &
447  mpi_sum, &
448  prc_local_comm_world, &
449  ierr )
450  call prof_rapend ('COMM_Allreduce', 2)
451 
452  do k = ks, ke
453  if ( allstatval(2,k) > 0.0_dp ) then
454  varmean(k) = allstatval(1,k) / allstatval(2,k)
455  else
456  varmean(k) = undef
457  end if
458  enddo
459  do k = 1, ks-1
460  varmean(k) = undef
461  end do
462  do k = ke+1, ka
463  varmean(k) = undef
464  end do
465 
466  return

References scale_const::const_undef, scale_prc::prc_local_comm_world, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_horizontal_min_2d()

subroutine scale_statistics::statistics_horizontal_min_2d ( integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension(ia,ja), intent(in)  var,
real(rp), intent(out)  varmin 
)

Calc horizontal minimum value.

Definition at line 475 of file scale_statistics.F90.

475  use scale_const, only: &
476  undef => const_undef, &
477  huge => const_huge
478  use scale_comm_cartesc, only: &
479  comm_datatype
480  integer, intent(in) :: IA, IS, IE
481  integer, intent(in) :: JA, JS, JE
482 
483  real(RP), intent(in) :: var(IA,JA)
484  real(RP), intent(out) :: varmin
485 
486  real(RP) :: statval
487  real(RP) :: allstatval
488 
489  integer :: ierr
490  integer :: i, j
491  !---------------------------------------------------------------------------
492 
493  statval = huge
494  !$omp parallel do reduction(min:statval)
495  do j = js, je
496  do i = is, ie
497  if ( var(i,j) /= undef .and. var(i,j) < statval ) then
498  statval = var(i,j)
499  endif
500  enddo
501  enddo
502 
503  call prof_rapstart('COMM_Allreduce', 2)
504  ! All reduce
505  call mpi_allreduce( statval, &
506  allstatval, &
507  1, &
508  comm_datatype, &
509  mpi_min, &
510  prc_local_comm_world, &
511  ierr )
512  call prof_rapend ('COMM_Allreduce', 2)
513 
514  if ( allstatval < huge ) then
515  varmin = allstatval
516  else
517  varmin = undef
518  end if
519 
520  return

References scale_comm_cartesc::comm_datatype, scale_const::const_huge, scale_const::const_undef, scale_prc::prc_local_comm_world, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_horizontal_min_3d()

subroutine scale_statistics::statistics_horizontal_min_3d ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension(ka,ia,ja), intent(in)  var,
real(rp), dimension(ka), intent(out)  varmin 
)

Definition at line 527 of file scale_statistics.F90.

527  use scale_const, only: &
528  undef => const_undef, &
529  huge => const_huge
530  use scale_comm_cartesc, only: &
531  comm_datatype
532  integer, intent(in) :: KA, KS, KE
533  integer, intent(in) :: IA, IS, IE
534  integer, intent(in) :: JA, JS, JE
535 
536  real(RP), intent(in) :: var(KA,IA,JA)
537  real(RP), intent(out) :: varmin(KA)
538 
539  real(RP) :: statval (KA)
540  real(RP) :: allstatval(KA)
541 
542  integer :: ierr
543  integer :: k, i, j
544  !---------------------------------------------------------------------------
545 
546  statval(:) = huge
547 ! !$omp parallel do reduction(min:statval)
548  do j = js, je
549  do i = is, ie
550  do k = ks, ke
551  if ( var(k,i,j) /= undef .and. var(k,i,j) < statval(k) ) then
552  statval(k) = var(k,i,j)
553  endif
554  enddo
555  enddo
556  enddo
557 
558  call prof_rapstart('COMM_Allreduce', 2)
559  ! All reduce
560  call mpi_allreduce( statval(ks:ke), &
561  allstatval(ks:ke), &
562  ke-ks+1, &
563  comm_datatype, &
564  mpi_min, &
565  prc_local_comm_world, &
566  ierr )
567  call prof_rapend ('COMM_Allreduce', 2)
568 
569  do k = ks, ke
570  if ( allstatval(k) < huge ) then
571  varmin(k) = allstatval(k)
572  else
573  varmin(k) = undef
574  end if
575  enddo
576  do k = 1, ks-1
577  varmin(k) = undef
578  end do
579  do k = ke+1, ka
580  varmin(k) = undef
581  end do
582 
583  return

References scale_comm_cartesc::comm_datatype, scale_const::const_huge, scale_const::const_undef, scale_prc::prc_local_comm_world, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_horizontal_max_2d()

subroutine scale_statistics::statistics_horizontal_max_2d ( integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension(ia,ja), intent(in)  var,
real(rp), intent(out)  varmax 
)

Calc horizontal maximum value.

Definition at line 592 of file scale_statistics.F90.

592  use scale_const, only: &
593  undef => const_undef, &
594  huge => const_huge
595  use scale_comm_cartesc, only: &
596  comm_datatype
597  integer, intent(in) :: IA, IS, IE
598  integer, intent(in) :: JA, JS, JE
599 
600  real(RP), intent(in) :: var(IA,JA)
601  real(RP), intent(out) :: varmax
602 
603  real(RP) :: statval
604  real(RP) :: allstatval
605 
606  integer :: ierr
607  integer :: i, j
608  !---------------------------------------------------------------------------
609 
610  statval = - huge
611  !$omp parallel do reduction(max:statval)
612  do j = js, je
613  do i = is, ie
614  if ( var(i,j) /= undef .and. var(i,j) > statval ) then
615  statval = var(i,j)
616  endif
617  enddo
618  enddo
619 
620  call prof_rapstart('COMM_Allreduce', 2)
621  ! All reduce
622  call mpi_allreduce( statval, &
623  allstatval, &
624  1, &
625  comm_datatype, &
626  mpi_max, &
627  prc_local_comm_world, &
628  ierr )
629  call prof_rapend ('COMM_Allreduce', 2)
630 
631  if ( allstatval > - huge ) then
632  varmax = allstatval
633  else
634  varmax = undef
635  end if
636 
637  return

References scale_comm_cartesc::comm_datatype, scale_const::const_huge, scale_const::const_undef, scale_prc::prc_local_comm_world, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_horizontal_max_3d()

subroutine scale_statistics::statistics_horizontal_max_3d ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
real(rp), dimension(ka,ia,ja), intent(in)  var,
real(rp), dimension(ka), intent(out)  varmax 
)

Definition at line 644 of file scale_statistics.F90.

644  use scale_const, only: &
645  undef => const_undef, &
646  huge => const_huge
647  use scale_comm_cartesc, only: &
648  comm_datatype
649  integer, intent(in) :: KA, KS, KE
650  integer, intent(in) :: IA, IS, IE
651  integer, intent(in) :: JA, JS, JE
652 
653  real(RP), intent(in) :: var(KA,IA,JA)
654  real(RP), intent(out) :: varmax(KA)
655 
656  real(RP) :: statval (KA)
657  real(RP) :: allstatval(KA)
658 
659  integer :: ierr
660  integer :: k, i, j
661  !---------------------------------------------------------------------------
662 
663  statval(:) = - huge
664 ! !$omp parallel do reduction(max:statval)
665  do j = js, je
666  do i = is, ie
667  do k = ks, ke
668  if ( var(k,i,j) /= undef .and. var(k,i,j) > statval(k) ) then
669  statval(k) = var(k,i,j)
670  endif
671  enddo
672  enddo
673  enddo
674 
675  call prof_rapstart('COMM_Allreduce', 2)
676  ! All reduce
677  call mpi_allreduce( statval(ks:ke), &
678  allstatval(ks:ke), &
679  ke-ks+1, &
680  comm_datatype, &
681  mpi_max, &
682  prc_local_comm_world, &
683  ierr )
684  call prof_rapend ('COMM_Allreduce', 2)
685 
686  do k = ks, ke
687  if ( allstatval(k) > - huge ) then
688  varmax(k) = allstatval(k)
689  else
690  varmax(k) = undef
691  end if
692  enddo
693  do k = 1, ks-1
694  varmax(k) = undef
695  end do
696  do k = ke+1, ka
697  varmax(k) = undef
698  end do
699 
700  return

References scale_comm_cartesc::comm_datatype, scale_const::const_huge, scale_const::const_undef, scale_prc::prc_local_comm_world, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_detail_3d()

subroutine scale_statistics::statistics_detail_3d ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  VA,
character(len=*), dimension(va), intent(in)  varname,
real(rp), dimension(ka,ia,ja,va), intent(in)  var,
logical, intent(in), optional  local 
)

Search global maximum & minimum value.

Parameters
[in]varnamename of item
[in]varvalues
[in]localcalc in local node

Definition at line 709 of file scale_statistics.F90.

709  use scale_prc, only: &
710  prc_nprocs
711  use scale_comm_cartesc, only: &
712  comm_datatype
713  implicit none
714 
715  integer, intent(in) :: KA, KS, KE
716  integer, intent(in) :: IA, IS, IE
717  integer, intent(in) :: JA, JS, JE
718  integer, intent(in) :: VA
719 
720  character(len=*), intent(in) :: varname(VA)
721  real(RP), intent(in) :: var(KA,IA,JA,VA)
722 
723  logical, intent(in), optional :: local
724 
725  real(RP) :: statval_l ( VA,2)
726  integer :: statidx_l (3,VA,2)
727  real(RP) :: statval ( VA,2,0:PRC_nprocs-1)
728  integer :: statidx (3,VA,2,0:PRC_nprocs-1)
729  real(RP) :: allstatval(VA,2)
730  integer :: allstatidx(VA,2)
731  logical :: do_globalcomm
732 
733  integer :: k, i, j
734  integer :: ierr
735  integer :: v, p
736  !---------------------------------------------------------------------------
737 
738  do_globalcomm = statistics_use_globalcomm
739  if ( present(local) ) do_globalcomm = ( .not. local )
740 
741  log_newline
742  log_info("STATISTICS_detail_3D",*) 'Variable Statistics '
743  do v = 1, va
744  statval_l( v,:) = var(ks,is,js,v)
745  statidx_l(1,v,:) = ks
746  statidx_l(2,v,:) = is
747  statidx_l(3,v,:) = js
748  do j = js, je
749  do i = is, ie
750  do k = ks, ke
751  if ( var(k,i,j,v) > statval_l(v,1) ) then
752  statval_l( v,1) = var(k,i,j,v)
753  statidx_l(1,v,1) = k
754  statidx_l(2,v,1) = i
755  statidx_l(3,v,1) = j
756  end if
757  if ( var(k,i,j,v) < statval_l(v,2) ) then
758  statval_l( v,2) = var(k,i,j,v)
759  statidx_l(1,v,2) = k
760  statidx_l(2,v,2) = i
761  statidx_l(3,v,2) = j
762  end if
763  end do
764  end do
765  end do
766  enddo
767 
768  if ( do_globalcomm ) then
769  call prof_rapstart('COMM_Bcast', 2)
770 
771  call mpi_allgather( statval_l(:,:), &
772  va*2, &
773  comm_datatype, &
774  statval(:,:,:), &
775  va*2, &
776  comm_datatype, &
777  prc_local_comm_world, &
778  ierr )
779 
780  call mpi_allgather( statidx_l(:,:,:), &
781  3*va*2, &
782  mpi_integer, &
783  statidx(:,:,:,:), &
784  3*va*2, &
785  mpi_integer, &
786  prc_local_comm_world, &
787  ierr )
788 
789  call prof_rapend ('COMM_Bcast', 2)
790 
791  do v = 1, va
792  allstatval(v,1) = statval(v,1,0)
793  allstatval(v,2) = statval(v,2,0)
794  allstatidx(v,:) = 0
795  do p = 1, prc_nprocs-1
796  if ( statval(v,1,p) > allstatval(v,1) ) then
797  allstatval(v,1) = statval(v,1,p)
798  allstatidx(v,1) = p
799  end if
800  if ( statval(v,2,p) < allstatval(v,2) ) then
801  allstatval(v,2) = statval(v,2,p)
802  allstatidx(v,2) = p
803  end if
804  end do
805  log_info_cont(*) '[', trim(varname(v)), ']'
806  log_info_cont('(1x,A,ES17.10,A,4(I5,A))') ' MAX =', &
807  allstatval(v,1), ' (rank=', &
808  allstatidx(v,1), '; ', &
809  statidx(1,v,1,allstatidx(v,1)),',', &
810  statidx(2,v,1,allstatidx(v,1)),',', &
811  statidx(3,v,1,allstatidx(v,1)),')'
812  log_info_cont('(1x,A,ES17.10,A,4(I5,A))') ' MIN =', &
813  allstatval(v,2), ' (rank=', &
814  allstatidx(v,2), '; ', &
815  statidx(1,v,2,allstatidx(v,2)),',', &
816  statidx(2,v,2,allstatidx(v,2)),',', &
817  statidx(3,v,2,allstatidx(v,2)),')'
818  enddo
819  else
820  ! statistics on each node
821  do v = 1, va
822  log_info_cont(*) '[', trim(varname(v)), ']'
823  log_info_cont('(1x,A,ES17.10,A,3(I5,A))') 'MAX = ', &
824  statval_l( v,1),' (', &
825  statidx_l(1,v,1),',', &
826  statidx_l(2,v,1),',', &
827  statidx_l(3,v,1),')'
828  log_info_cont('(1x,A,ES17.10,A,3(I5,A))') 'MIN = ', &
829  statval_l( v,2),' (', &
830  statidx_l(1,v,2),',', &
831  statidx_l(2,v,2),',', &
832  statidx_l(3,v,2),')'
833  enddo
834  endif
835 
836  log_newline
837 
838  return

References scale_comm_cartesc::comm_datatype, scale_prc::prc_nprocs, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

◆ statistics_detail_2d()

subroutine scale_statistics::statistics_detail_2d ( integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  VA,
character(len=*), dimension(va), intent(in)  varname,
real(rp), dimension(ia,ja,va), intent(in)  var,
logical, intent(in), optional  local 
)
Parameters
[in]varnamename of item
[in]varvalues

Definition at line 845 of file scale_statistics.F90.

845  use scale_prc, only: &
846  prc_nprocs, &
847  prc_myrank
848  use scale_comm_cartesc, only: &
849  comm_datatype
850  implicit none
851 
852  integer, intent(in) :: IA, IS, IE
853  integer, intent(in) :: JA, JS, JE
854  integer, intent(in) :: VA
855 
856  character(len=*), intent(in) :: varname(VA)
857  real(RP), intent(in) :: var(IA,JA,VA)
858 
859  logical, intent(in), optional :: local ! calc in local node
860 
861  real(RP) :: statval_l ( VA,2)
862  integer :: statidx_l (2,VA,2)
863  real(RP) :: statval ( VA,2,0:PRC_nprocs-1)
864  integer :: statidx (2,VA,2,0:PRC_nprocs-1)
865  real(RP) :: allstatval(VA,2)
866  integer :: allstatidx(VA,2)
867  logical :: do_globalcomm
868 
869  integer :: i, j
870  integer :: ierr
871  integer :: v, p
872  !---------------------------------------------------------------------------
873 
874  do_globalcomm = statistics_use_globalcomm
875  if ( present(local) ) do_globalcomm = ( .not. local )
876 
877  log_newline
878  log_info("STATISTICS_detail_2D",*) 'Variable Statistics '
879  do v = 1, va
880  statval_l( v,:) = var(is,js,v)
881  statidx_l(1,v,:) = is
882  statidx_l(2,v,:) = js
883  do j = js, je
884  do i = is, ie
885  if ( var(i,j,v) > statval_l(v,1) ) then
886  statval_l( v,1) = var(i,j,v)
887  statidx_l(1,v,1) = i
888  statidx_l(2,v,1) = j
889  end if
890  if ( var(i,j,v) < statval_l(v,2) ) then
891  statval_l( v,2) = var(i,j,v)
892  statidx_l(1,v,2) = i
893  statidx_l(2,v,2) = j
894  end if
895  end do
896  end do
897  enddo
898 
899  if ( do_globalcomm ) then
900  call prof_rapstart('COMM_Bcast', 2)
901 
902  call mpi_allgather( statval_l(:,:), &
903  va*2, &
904  comm_datatype, &
905  statval(:,:,:), &
906  va*2, &
907  comm_datatype, &
908  prc_local_comm_world, &
909  ierr )
910 
911  call mpi_allgather( statidx_l(:,:,:), &
912  2*va*2, &
913  mpi_integer, &
914  statidx(:,:,:,:), &
915  2*va*2, &
916  mpi_integer, &
917  prc_local_comm_world, &
918  ierr )
919 
920  call prof_rapend ('COMM_Bcast', 2)
921 
922  do v = 1, va
923  allstatval(v,1) = statval(v,1,0)
924  allstatval(v,2) = statval(v,2,0)
925  allstatidx(v,:) = 0
926  do p = 1, prc_nprocs-1
927  if ( statval(v,1,p) > allstatval(v,1) ) then
928  allstatval(v,1) = statval(v,1,p)
929  allstatidx(v,1) = p
930  end if
931  if ( statval(v,2,p) < allstatval(v,2) ) then
932  allstatval(v,2) = statval(v,2,p)
933  allstatidx(v,2) = p
934  end if
935  end do
936  log_info_cont(*) '[', trim(varname(v)), ']'
937  log_info_cont('(1x,A,ES17.10,A,3(I5,A))') ' MAX =', &
938  allstatval(v,1), ' (rank=', &
939  allstatidx(v,1), '; ', &
940  statidx(1,v,1,allstatidx(v,1)),',', &
941  statidx(2,v,1,allstatidx(v,1)),')'
942  log_info_cont('(1x,A,ES17.10,A,3(I5,A))') ' MIN =', &
943  allstatval(v,2), ' (rank=', &
944  allstatidx(v,2), '; ', &
945  statidx(1,v,2,allstatidx(v,2)),',', &
946  statidx(2,v,2,allstatidx(v,2)),')'
947  enddo
948  else
949  ! statistics on each node
950  do v = 1, va
951  log_info_cont(*) '[', trim(varname(v)), ']'
952  log_info_cont('(1x,A,ES17.10,A,2(I5,A))') 'MAX = ', &
953  statval_l( v,1),' (', &
954  statidx_l(1,v,1),',', &
955  statidx_l(2,v,1),')'
956  log_info_cont('(1x,A,ES17.10,A,2(I5,A))') 'MIN = ', &
957  statval_l( v,2),' (', &
958  statidx_l(1,v,2),',', &
959  statidx_l(2,v,2),')'
960  enddo
961  endif
962 
963  log_newline
964 
965  return

References scale_comm_cartesc::comm_datatype, scale_prc::prc_myrank, scale_prc::prc_nprocs, scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

Here is the call graph for this function:

Variable Documentation

◆ statistics_checktotal

logical, public scale_statistics::statistics_checktotal = .false.
scale_comm_cartesc::comm_setup
subroutine, public comm_setup
Setup.
Definition: scale_comm_cartesC.F90:145
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11