PartMC  2.3.0
stats.F90
Go to the documentation of this file.
1 ! Copyright (C) 2012-2015 Matthew West
2 ! Licensed under the GNU General Public License version 2 or (at your
3 ! option) any later version. See the file COPYING for details.
4 
5 !> \file
6 !> The pmc_stats module.
7 
8 !> The \c stats_t type and associated subroutines.
9 module pmc_stats
10 
11  use pmc_util
12  use pmc_netcdf
13 
14  !> Structure for online computation of mean and variance.
15  type stats_t
16  !> Number of samples included so far.
17  integer :: n = 0
18  !> Current mean estimate.
19  real(kind=dp) :: mean
20  !> Current variance estimate.
21  real(kind=dp) :: var
22  end type stats_t
23 
24  !> Structure for online computation of 1D arrays of mean and variance.
26  !> Number of samples included so far.
27  integer, allocatable :: n(:)
28  !> Current mean estimates.
29  real(kind=dp), allocatable :: mean(:)
30  !> Current variance estimates.
31  real(kind=dp), allocatable :: var(:)
32  end type stats_1d_t
33 
34  !> Structure for online computation of 2D arrays of mean and variance.
36  !> Number of samples included so far.
37  integer, allocatable :: n(:, :)
38  !> Current mean estimates.
39  real(kind=dp), allocatable :: mean(:, :)
40  !> Current variance estimates.
41  real(kind=dp), allocatable :: var(:, :)
42  end type stats_2d_t
43 
44 contains
45 
46 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
47 
48  !> Clear data statistics collected so far.
49  subroutine stats_clear(stats)
50 
51  !> Statistics structure to clear.
52  type(stats_t), intent(inout) :: stats
53 
54  stats%n = 0
55 
56  end subroutine stats_clear
57 
58 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
59 
60  !> Clear data statistics collected so far.
61  subroutine stats_1d_clear(stats)
62 
63  !> Statistics structure to clear.
64  type(stats_1d_t), intent(inout) :: stats
65 
66  if (allocated(stats%n)) then
67  deallocate(stats%n)
68  deallocate(stats%mean)
69  deallocate(stats%var)
70  end if
71 
72  end subroutine stats_1d_clear
73 
74 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
75 
76  !> Clear data statistics collected so far.
77  subroutine stats_2d_clear(stats)
78 
79  !> Statistics structure to clear.
80  type(stats_2d_t), intent(inout) :: stats
81 
82  if (allocated(stats%n)) then
83  deallocate(stats%n)
84  deallocate(stats%mean)
85  deallocate(stats%var)
86  end if
87 
88  end subroutine stats_2d_clear
89 
90 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
91 
92  !> Add a new data value to a \c stats_t structure.
93  subroutine stats_add(stats, data)
94 
95  !> Statistics structure to add to.
96  type(stats_t), intent(inout) :: stats
97  !> Data value to add.
98  real(kind=dp), intent(in) :: data
99 
100  stats%n = stats%n + 1
101  call update_mean_var(stats%mean, stats%var, data, stats%n)
102 
103  end subroutine stats_add
104 
105 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
106 
107  !> Add all new data values to a \c stats_1d_t structure.
108  subroutine stats_1d_add(stats, data)
109 
110  !> Statistics structure to add to.
111  type(stats_1d_t), intent(inout) :: stats
112  !> Data values to add.
113  real(kind=dp), intent(in) :: data(:)
114 
115  integer :: i
116 
117  if (.not. allocated(stats%n)) then
118  allocate(stats%n(size(data)))
119  allocate(stats%mean(size(data)))
120  allocate(stats%var(size(data)))
121  stats%n = 0
122  end if
123 
124  call assert_msg(851913829, size(stats%n) == size(data), &
125  "size mismatch between existing n and newly added data")
126  call assert_msg(933021218, size(stats%mean) == size(data), &
127  "size mismatch between existing mean and newly added data")
128  call assert_msg(170092922, size(stats%var) == size(data), &
129  "size mismatch between existing var and newly added data")
130  stats%n = stats%n + 1
131  do i = 1,size(data)
132  call update_mean_var(stats%mean(i), stats%var(i), data(i), stats%n(i))
133  end do
134 
135  end subroutine stats_1d_add
136 
137 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
138 
139  !> Add a new single data value to a \c stats_1d_t structure.
140  subroutine stats_1d_add_entry(stats, data, i)
141 
142  !> Statistics structure to add to.
143  type(stats_1d_t), intent(inout) :: stats
144  !> Data value to add.
145  real(kind=dp), intent(in) :: data
146  !> Index of data value to add.
147  integer, intent(in) :: i
148 
149  call assert_msg(802003511, i >= 1, "cannot use a non-positive index")
150  call ensure_integer_array_size(stats%n, i, only_grow=.true.)
151  call ensure_real_array_size(stats%mean, i, only_grow=.true.)
152  call ensure_real_array_size(stats%var, i, only_grow=.true.)
153 
154  stats%n(i) = stats%n(i) + 1
155  call update_mean_var(stats%mean(i), stats%var(i), data, stats%n(i))
156 
157  end subroutine stats_1d_add_entry
158 
159 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
160 
161  !> Add all new data values to a \c stats_2d_t structure.
162  subroutine stats_2d_add(stats, data)
163 
164  !> Statistics structure to add to.
165  type(stats_2d_t), intent(inout) :: stats
166  !> Data values to add.
167  real(kind=dp), intent(in) :: data(:, :)
168 
169  integer :: i, j
170 
171  if (.not. allocated(stats%n)) then
172  allocate(stats%n(size(data, 1), size(data, 2)))
173  allocate(stats%mean(size(data, 1), size(data, 2)))
174  allocate(stats%var(size(data, 1), size(data, 2)))
175  stats%n = 0
176  else
177  call assert_msg(563659350, all(shape(stats%n) == shape(data)), &
178  "size mismatch between existing n and newly added data")
179  call assert_msg(274220601, all(shape(stats%mean) == shape(data)), &
180  "size mismatch between existing mean and newly added data")
181  call assert_msg(939179895, all(shape(stats%var) == shape(data)), &
182  "size mismatch between existing var and newly added data")
183  end if
184  stats%n = stats%n + 1
185  do i = 1,size(data, 1)
186  do j = 1,size(data, 2)
187  call update_mean_var(stats%mean(i, j), stats%var(i, j), data(i, j), &
188  stats%n(i, j))
189  end do
190  end do
191 
192  end subroutine stats_2d_add
193 
194 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
195 
196  !> Add a row of new data values to a \c stats_2d_t structure.
197  subroutine stats_2d_add_row(stats, data, i)
198 
199  !> Statistics structure to add to.
200  type(stats_2d_t), intent(inout) :: stats
201  !> Data values to add.
202  real(kind=dp), intent(in) :: data(:)
203  !> Row of data value to add.
204  integer, intent(in) :: i
205 
206  integer :: j
207 
208  call assert_msg(549391523, i >= 1, "cannot use a non-positive row")
209  if (allocated(stats%n)) then
210  call assert_msg(286470660, size(stats%n, 2) == size(data), &
211  "size mismatch between existing n and newly added data")
212  call assert_msg(901102174, size(stats%mean, 2) == size(data), &
213  "size mismatch between existing mean and newly added data")
214  call assert_msg(993806885, size(stats%var, 2) == size(data), &
215  "size mismatch between existing var and newly added data")
216  end if
217  call ensure_integer_array_2d_size(stats%n, i, size(stats%n, 2), &
218  only_grow=.true.)
219  call ensure_real_array_2d_size(stats%mean, i, size(stats%mean, 2), &
220  only_grow=.true.)
221  call ensure_real_array_2d_size(stats%var, i, size(stats%var, 2), &
222  only_grow=.true.)
223 
224  do j = 1,size(stats%n, 2)
225  stats%n(i, j) = stats%n(i, j) + 1
226  call update_mean_var(stats%mean(i, j), stats%var(i, j), data(j), &
227  stats%n(i, j))
228  end do
229 
230  end subroutine stats_2d_add_row
231 
232 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
233 
234  !> Add a column of new data values to a \c stats_2d_t structure.
235  subroutine stats_2d_add_col(stats, data, j)
236 
237  !> Statistics structure to add to.
238  type(stats_2d_t), intent(inout) :: stats
239  !> Data values to add.
240  real(kind=dp), intent(in) :: data(:)
241  !> Column of data value to add.
242  integer, intent(in) :: j
243 
244  integer :: i
245 
246  call assert_msg(944718123, j >= 1, "cannot use a non-positive column")
247  if (allocated(stats%n)) then
248  call assert_msg(170275693, size(stats%n, 1) == size(data), &
249  "size mismatch between existing n and newly added data")
250  call assert_msg(659257452, size(stats%mean, 1) == size(data), &
251  "size mismatch between existing mean and newly added data")
252  call assert_msg(279552980, size(stats%var, 1) == size(data), &
253  "size mismatch between existing var and newly added data")
254  end if
255  call ensure_integer_array_2d_size(stats%n, size(stats%n, 1), j, &
256  only_grow=.true.)
257  call ensure_real_array_2d_size(stats%mean, size(stats%mean, 1), j, &
258  only_grow=.true.)
259  call ensure_real_array_2d_size(stats%var, size(stats%var, 1), j, &
260  only_grow=.true.)
261 
262  do i = 1,size(stats%n, 1)
263  stats%n(i, j) = stats%n(i, j) + 1
264  call update_mean_var(stats%mean(i, j), stats%var(i, j), data(i), &
265  stats%n(i, j))
266  end do
267 
268  end subroutine stats_2d_add_col
269 
270 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
271 
272  !> Add a single new data value to a \c stats_2d_t structure.
273  subroutine stats_2d_add_entry(stats, data, i, j)
274 
275  !> Statistics structure to add to.
276  type(stats_2d_t), intent(inout) :: stats
277  !> Data values to add.
278  real(kind=dp), intent(in) :: data
279  !> First index of data value to add.
280  integer, intent(in) :: i
281  !> Second index of data value to add.
282  integer, intent(in) :: j
283 
284  call assert_msg(522548347, (i >= 1) .and. (j >= 1), &
285  "cannot use non-positive indexes")
286  call ensure_integer_array_2d_size(stats%n, i, j)
287  call ensure_real_array_2d_size(stats%mean, i, j)
288  call ensure_real_array_2d_size(stats%var, i, j)
289 
290  stats%n(i, j) = stats%n(i, j) + 1
291  call update_mean_var(stats%mean(i, j), stats%var(i, j), data, &
292  stats%n(i, j))
293 
294  end subroutine stats_2d_add_entry
295 
296 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
297 
298  !> Compute the 95% confidence interval offset from the mean.
299  function stats_conf_95_offset(stats)
300 
301  !> Statistics structure to find confidence interval for.
302  type(stats_t), intent(in) :: stats
303 
304  !> Return offset so that [mean - offset, mean + offset] is the 95%
305  !> confidence interval.
306  real(kind=dp) :: stats_conf_95_offset
307 
308  stats_conf_95_offset = conf_95_offset(stats%var, stats%n)
309 
310  end function stats_conf_95_offset
311 
312 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
313 
314  !> Compute the 95% confidence interval offset from the mean.
315  function stats_1d_conf_95_offset(stats)
316 
317  !> Statistics structure to find confidence interval for.
318  type(stats_1d_t), intent(in) :: stats
319 
320  !> Return offset so that [mean - offset, mean + offset] is the 95%
321  !> confidence interval.
322  real(kind=dp) :: stats_1d_conf_95_offset(size(stats%n))
323 
324  integer :: i
325 
326  do i = 1,size(stats%n)
327  stats_1d_conf_95_offset(i) = conf_95_offset(stats%var(i), stats%n(i))
328  end do
329 
330  end function stats_1d_conf_95_offset
331 
332 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
333 
334  !> Compute the 95% confidence interval offset from the mean.
335  function stats_2d_conf_95_offset(stats)
336 
337  !> Statistics structure to find confidence interval for.
338  type(stats_2d_t), intent(in) :: stats
339 
340  !> Return offset so that [mean - offset, mean + offset] is the 95%
341  !> confidence interval.
342  real(kind=dp) :: stats_2d_conf_95_offset(size(stats%n, 1), &
343  size(stats%n, 2))
344 
345  integer :: i, j
346 
347  do i = 1,size(stats%n, 1)
348  do j = 1,size(stats%n, 2)
349  stats_2d_conf_95_offset(i, j) = conf_95_offset(stats%var(i, j), &
350  stats%n(i, j))
351  end do
352  end do
353 
354  end function stats_2d_conf_95_offset
355 
356 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
357 
358  !> Compute a running average and variance.
359  !!
360  !! Given a sequence of data <tt>x(i)</tt> for <tt>i = 1,...,n</tt>,
361  !! this should be called like
362  !! <pre>
363  !! do i = 1,n
364  !! call update_mean_var(mean, var, x(i), i)
365  !! end do
366  !! </pre>
367  !! After each call the variables \c mean and \c var will be the
368  !! sample mean and sample variance of the sequence elements up to \c
369  !! i.
370  !!
371  !! This computes the sample mean and sample variance using a
372  !! recurrence. The initial sample mean is \f$m_1 = x_1\f$ and the
373  !! initial sample variance is \f$v_1 = 0\f$ for \f$n = 1\f$, and
374  !! then for \f$n \ge 2\f$ we use the mean update
375  !! \f[
376  !! m_n = m_{n-1} + \frac{x_n - m_{n-1}}{n}
377  !! \f]
378  !! and the variance update
379  !! \f[
380  !! v_n = \frac{n - 2}{n - 1} v_{n-1}
381  !! + \frac{(x_n - m_{n-1})^2}{n}.
382  !! \f]
383  !! Then \f$m_n\f$ and \f$v_n\f$ are the sample mean and sample
384  !! variance for \f$\{x_1,\ldots,x_n\}\f$ for each \f$n\f$.
385  !!
386  !! The derivation of these formulas begins with the definitions for
387  !! the running total
388  !! \f[
389  !! t_n = \sum_{i=1}^n x_i
390  !! \f]
391  !! and running sum of square differences
392  !! \f[
393  !! s_n = \sum_{i=1}^n (x_i - m_n)^2.
394  !! \f]
395  !! Then the running mean is \f$m_n = \frac{t_n}{n}\f$, the running
396  !! population variance is \f$p_n = \frac{1}{n} \left( s_n - n m_n^2
397  !! \right)\f$, and the running sample variance \f$v_n = \frac{1}{n -
398  !! 1} \left( s_n - n m_n^2 \right)\f$.
399  !!
400  !! We can then compute the mean update above, and observing that
401  !! \f[
402  !! s_n = \sum_{i=1}^n x_i^2 - n m_n^2
403  !! \f]
404  !! we can compute the sum-of-square-dfferences update identity
405  !! \f[
406  !! s_n = s_{n-1} + \frac{n - 1}{n} (x_n - m_{n-1})^2.
407  !! \f]
408  !! The algorithm then follows immediately. The population variance
409  !! update is given by
410  !! \f[
411  !! p_n = \frac{n-1}{n} p_{n-1} + \frac{(x_n - m_n)(x_n - m_{n-1})}{n}
412  !! = \frac{n-1}{n} p_{n-1} + \frac{n-1}{n^2} (x_n - m_{n-1})^2.
413  !! \f]
414  !!
415  !! This algorithm (in a form where \f$m_n\f$ and \f$s_n\f$ are
416  !! tracked) originally appeared in:
417  !!
418  !! B. P. Welford [1962] "Note on a Method for Calculating Corrected
419  !! Sums of Squares and Products", Technometrics 4(3), 419-420.
420  !!
421  !! Numerical tests performed by M. West on 2012-04-12 seem to
422  !! indicate that there is no substantial difference between tracking
423  !! \f$s_n\f$ versus \f$v_n\f$.
424  !!
425  !! The same method (tracking \f$m_n\f$ and \f$s_n\f$) is presented
426  !! on page 232 in Section 4.2.2 of Knuth:
427  !!
428  !! D. E. Knuth [1988] "The Art of Computer Programming, Volume 2:
429  !! Seminumerical Algorithms", third edition, Addison Wesley Longman,
430  !! ISBN 0-201-89684-2.
431  !!
432  !! An analysis of the error introduced by different variance
433  !! computation methods is given in:
434  !!
435  !! T. F. Chan, G. H. Golub, and R. J. LeVeque [1983] "Algorithms for
436  !! Computing the Sample Variance: Analysis and Recommendations", The
437  !! American Statistician 37(3), 242-247.
438  !!
439  !! The relative error in \f$s_n\f$ of Welford's method (tracking
440  !! \f$m_n\f$ and \f$s_n\f$) is of order \f$n \kappa \epsilon\f$,
441  !! where \f$\epsilon\f$ is the machine precision and \f$\kappa\f$ is
442  !! the condition number for the problem, which is given by
443  !! \f[
444  !! \kappa = \frac{\|x\|_2}{\sqrt{s_n}}
445  !! = \sqrt{1 + \frac{m_n^2}{p_n}}
446  !! \approx \frac{m_n}{p_n}.
447  !! \f]
448  !!
449  !! This analysis was apparently first given in:
450  !!
451  !! T. F. C. Chan and J. G. Lewis [1978] "Rounding error analysis of
452  !! algorithms for computing means and standard deviations",
453  !! Technical Report No. 284, The Johns Hopkins University,
454  !! Department of Mathematical Sciences.
455  subroutine update_mean_var(mean, var, data, n)
456 
457  !> Mean value to update (on entry \f$m_{n-1}\f$, on exit \f$m_n\f$).
458  real(kind=dp), intent(inout) :: mean
459  !> Variance value to update (on entry \f$v_{n-1}\f$, on exit \f$v_n\f$).
460  real(kind=dp), intent(inout) :: var
461  !> Data value \f$x_n\f$.
462  real(kind=dp), intent(in) :: data
463  !> Number \f$n\f$ of this data value.
464  integer, intent(in) :: n
465 
466  real(kind=dp) :: data_diff
467 
468  call assert_msg(376972566, n >= 1, &
469  "must have number n >= 1, not: " // trim(integer_to_string(n)))
470  if (n == 1) then
471  mean = data
472  var = 0d0
473  else
474  data_diff = data - mean
475  mean = mean + data_diff / real(n, kind=dp)
476  var = real(n - 2, kind=dp) / real(n - 1, kind=dp) * var &
477  + data_diff**2 / real(n, kind=dp)
478  end if
479 
480  end subroutine update_mean_var
481 
482 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
483 
484  !> Return a fairly tight upper-bound on the Student's t coefficient
485  !> for the 95% confidence interval.
486  !!
487  !! The number of degrees of freedom is one less than \c n_sample. If
488  !! a set of \f$n\f$ numbers has sample mean \f$\mu\f$ and sample
489  !! standard deviation \f$\sigma\f$, then the 95% confidence interval
490  !! for the mean is \f$[\mu - r\sigma/\sqrt{n}, \mu +
491  !! r\sigma/\sqrt{n}]\f$, where <tt>r =
492  !! student_t_95_coeff(n_sample)</tt>.
493  !!
494  !! The method used here was written by MW on 2011-05-01, based on
495  !! the following empirical observation. If \f$f(\nu) =
496  !! t_{0.95,\nu}\f$ is the function we want, where \f$\nu = n - 1\f$
497  !! is the number of degrees-of-freedom, then set \f$g(\nu) = f(\nu)
498  !! - L\f$, where \f$L = \Phi^{-1}(0.975)\f$ is the limiting value
499  !! given by the Gaussian CDF \f$\Phi\f$. We observe numerically that
500  !! \f$g'(\nu) < -1\f$ and \f$g'(\nu) \to -1\f$ as \f$\nu \to
501  !! \infty\f$. Thus \f$g(\nu)\f$ is well-approximated by \f$A/\nu\f$
502  !! for some \f$A\f$. Furthermore, if \f$g(\nu^*) = A^*/\nu\f$, then
503  !! \f$g(\nu) < A^*/\nu\f$ for \f$\nu > \nu^*\f$. We thus have
504  !! \f$f(\nu) \le (f(\nu^*) - L) (\nu^* / \nu) + L\f$ for \f$\nu \ge
505  !! \nu^*\f$. By using a sequence of known \f$(\nu^*, f(\nu^*))\f$
506  !! pairs we can thus construct a fairly tight upper bound.
507  !!
508  !! This implementation has an error of below 0.1% for all values of
509  !! \c n_sample.
510  real(kind=dp) function student_t_95_coeff(n_sample)
511 
512  !> Number of samples.
513  integer, intent(in) :: n_sample
514 
515  real(kind=dp), parameter :: limit = 1.959963984540054d0
516  real(kind=dp), parameter, dimension(15) :: values &
517  = (/ 12.7062047364d0, 4.30265272991d0, 3.18244630528d0, &
518  2.7764451052d0, 2.57058183661d0, 2.44691184879d0, 2.36462425101d0, &
519  2.30600413503d0, 2.26215716274d0, 2.22813885196d0, 2.20098516008d0, &
520  2.17881282966d0, 2.16036865646d0, 2.14478668792d0, 2.13144954556d0 /)
521 
522  integer :: n_dof
523 
524  n_dof = n_sample - 1
525  call assert(359779741, n_dof >= 1)
526  if (n_dof <= 15) then
527  student_t_95_coeff = values(n_dof)
528  elseif (n_dof <= 20) then
529  student_t_95_coeff = (2.11990529922d0 - limit) * 16d0 &
530  / real(n_dof, kind=dp) + limit
531  else
532  student_t_95_coeff = (2.07961384473d0 - limit) * 21d0 &
533  / real(n_dof, kind=dp) + limit
534  end if
535 
536  end function student_t_95_coeff
537 
538 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
539 
540  !> 95% confidence interval offset from mean.
541  !!
542  !! If \c mean and \c var are the sample mean and sample variance of
543  !! \c n data values, then
544  !! <pre>
545  !! offset = conf_95_offset(var, n)
546  !! </pre>
547  !! means that the 95% confidence interval for the mean is
548  !! <tt>[mean - offset, mean + offset]</tt>.
549  function conf_95_offset(var, n_sample)
550 
551  !> Sample variance of data.
552  real(kind=dp), intent(in) :: var
553  !> Number of samples.
554  integer, intent(in) :: n_sample
555 
556  !> Return offset from mean for the 95% confidence interval.
557  real(kind=dp) :: conf_95_offset
558 
559  conf_95_offset = student_t_95_coeff(n_sample) * sqrt(var) &
560  / sqrt(real(n_sample, kind=dp))
561 
562  end function conf_95_offset
563 
564 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
565 
566  !> Write statistics (mean and 95% conf. int.) to a NetCDF file.
567  subroutine stats_output_netcdf(stats, ncid, name, unit)
568 
569  !> Statistics structure to write.
570  type(stats_t), intent(in) :: stats
571  !> NetCDF file ID, in data mode.
572  integer, intent(in) :: ncid
573  !> Variable name in NetCDF file.
574  character(len=*), intent(in) :: name
575  !> Unit of variable.
576  character(len=*), optional, intent(in) :: unit
577 
578  call pmc_nc_write_real(ncid, stats%mean, name, unit=unit)
579  call pmc_nc_write_real(ncid, stats_conf_95_offset(stats), &
580  trim(name) // "_ci_offset", unit=unit)
581 
582  end subroutine stats_output_netcdf
583 
584 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
585 
586  !> Write statistics (mean and 95% conf. int.) to a NetCDF file.
587  subroutine stats_1d_output_netcdf(stats, ncid, name, dim_name, unit)
588 
589  !> Statistics structure to write.
590  type(stats_1d_t), intent(in) :: stats
591  !> NetCDF file ID, in data mode.
592  integer, intent(in) :: ncid
593  !> Variable name in NetCDF file.
594  character(len=*), intent(in) :: name
595  !> NetCDF dimension name for the variable.
596  character(len=*), optional, intent(in) :: dim_name
597  !> Unit of variable.
598  character(len=*), optional, intent(in) :: unit
599 
600  call pmc_nc_write_real_1d(ncid, stats%mean, name, dim_name=dim_name, &
601  unit=unit)
602  call pmc_nc_write_real_1d(ncid, stats_1d_conf_95_offset(stats), &
603  trim(name) // "_ci_offset", dim_name=dim_name, unit=unit)
604 
605  end subroutine stats_1d_output_netcdf
606 
607 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
608 
609  !> Write statistics (mean and 95% conf. int.) to a NetCDF file.
610  subroutine stats_2d_output_netcdf(stats, ncid, name, dim_name_1, &
611  dim_name_2, unit)
612 
613  !> Statistics structure to write.
614  type(stats_2d_t), intent(in) :: stats
615  !> NetCDF file ID, in data mode.
616  integer, intent(in) :: ncid
617  !> Variable name in NetCDF file.
618  character(len=*), intent(in) :: name
619  !> First NetCDF dimension name for the variable.
620  character(len=*), optional, intent(in) :: dim_name_1
621  !> Second NetCDF dimension name for the variable.
622  character(len=*), optional, intent(in) :: dim_name_2
623  !> Unit of variable.
624  character(len=*), optional, intent(in) :: unit
625 
626  call pmc_nc_write_real_2d(ncid, stats%mean, name, dim_name_1=dim_name_1, &
627  dim_name_2=dim_name_2, unit=unit)
628  call pmc_nc_write_real_2d(ncid, stats_2d_conf_95_offset(stats), &
629  trim(name) // "_ci_offset", dim_name_1=dim_name_1, &
630  dim_name_2=dim_name_2, unit=unit)
631 
632  end subroutine stats_2d_output_netcdf
633 
634 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
635 
636 end module pmc_stats
subroutine stats_2d_add_col(stats, data, j)
Add a column of new data values to a stats_2d_t structure.
Definition: stats.F90:235
subroutine pmc_nc_write_real_1d(ncid, var, name, dimids, dim_name, unit, long_name, standard_name, description)
Write a simple real array to a NetCDF file.
Definition: netcdf.F90:504
subroutine stats_add(stats, data)
Add a new data value to a stats_t structure.
Definition: stats.F90:93
subroutine stats_1d_add_entry(stats, data, i)
Add a new single data value to a stats_1d_t structure.
Definition: stats.F90:140
real(kind=dp) function, dimension(size(stats%n, 1),size(stats%n, 2)) stats_2d_conf_95_offset(stats)
Compute the 95% confidence interval offset from the mean.
Definition: stats.F90:335
subroutine ensure_integer_array_2d_size(x, n1, n2, only_grow)
Allocate or reallocate the given array to ensure it is of the given size, preserving any data and/or ...
Definition: util.F90:1108
subroutine stats_2d_add_row(stats, data, i)
Add a row of new data values to a stats_2d_t structure.
Definition: stats.F90:197
real(kind=dp) function stats_conf_95_offset(stats)
Compute the 95% confidence interval offset from the mean.
Definition: stats.F90:299
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
Definition: util.F90:76
subroutine stats_1d_add(stats, data)
Add all new data values to a stats_1d_t structure.
Definition: stats.F90:108
real(kind=dp) function conf_95_offset(var, n_sample)
95% confidence interval offset from mean.
Definition: stats.F90:549
subroutine stats_2d_clear(stats)
Clear data statistics collected so far.
Definition: stats.F90:77
Common utility subroutines.
Definition: util.F90:9
Structure for online computation of 1D arrays of mean and variance.
Definition: stats.F90:25
real(kind=dp) function student_t_95_coeff(n_sample)
Return a fairly tight upper-bound on the Student's t coefficient for the 95% confidence interval...
Definition: stats.F90:510
subroutine stats_2d_add(stats, data)
Add all new data values to a stats_2d_t structure.
Definition: stats.F90:162
subroutine stats_1d_output_netcdf(stats, ncid, name, dim_name, unit)
Write statistics (mean and 95% conf. int.) to a NetCDF file.
Definition: stats.F90:587
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
Definition: util.F90:743
subroutine stats_2d_output_netcdf(stats, ncid, name, dim_name_1, dim_name_2, unit)
Write statistics (mean and 95% conf. int.) to a NetCDF file.
Definition: stats.F90:610
Structure for online computation of 2D arrays of mean and variance.
Definition: stats.F90:35
subroutine pmc_nc_write_real_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple real 2D array to a NetCDF file.
Definition: netcdf.F90:602
subroutine pmc_nc_write_real(ncid, var, name, unit, long_name, standard_name, description)
Write a single real to a NetCDF file.
Definition: netcdf.F90:394
Structure for online computation of mean and variance.
Definition: stats.F90:15
subroutine ensure_real_array_size(x, n, only_grow)
Allocate or reallocate the given array to ensure it is of the given size, preserving any data and/or ...
Definition: util.F90:1000
Wrapper functions for NetCDF. These all take a NetCDF ncid in data mode and return with it again in d...
Definition: netcdf.F90:11
subroutine ensure_real_array_2d_size(x, n1, n2, only_grow)
Allocate or reallocate the given array to ensure it is of the given size, preserving any data and/or ...
Definition: util.F90:1034
subroutine stats_1d_clear(stats)
Clear data statistics collected so far.
Definition: stats.F90:61
real(kind=dp) function, dimension(size(stats%n)) stats_1d_conf_95_offset(stats)
Compute the 95% confidence interval offset from the mean.
Definition: stats.F90:315
The stats_t type and associated subroutines.
Definition: stats.F90:9
subroutine stats_2d_add_entry(stats, data, i, j)
Add a single new data value to a stats_2d_t structure.
Definition: stats.F90:273
subroutine stats_clear(stats)
Clear data statistics collected so far.
Definition: stats.F90:49
subroutine stats_output_netcdf(stats, ncid, name, unit)
Write statistics (mean and 95% conf. int.) to a NetCDF file.
Definition: stats.F90:567
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition: util.F90:102
subroutine update_mean_var(mean, var, data, n)
Compute a running average and variance.
Definition: stats.F90:455
subroutine ensure_integer_array_size(x, n, only_grow)
Allocate or reallocate the given array to ensure it is of the given size, preserving any data and/or ...
Definition: util.F90:1074