program main !*****************************************************************************80 ! !! prob_test() tests prob(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 19 September 2018 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) call timestamp ( ) write ( *, '(a)' ) '' write ( *, '(a)' ) 'prob_test():' write ( *, '(a)' ) ' FORTRAN90 version:' write ( *, '(a)' ) ' Test prob().' call angle_cdf_test ( ) call angle_mean_test ( ) call angle_pdf_test ( ) call anglit_cdf_test ( ) call anglit_sample_test ( ) call arcsin_cdf_test ( ) call arcsin_sample_test ( ) call benford_cdf_test ( ) call benford_pdf_test ( ) call benford_sample_test ( ) call bernoulli_cdf_test ( ) call bernoulli_sample_test ( ) call bessel_i0_test ( ) call bessel_i1_test ( ) call beta_binomial_cdf_test ( ) call beta_binomial_sample_test ( ) call beta_cdf_test ( ) call beta_inc_test ( ) call beta_sample_test ( ) call binomial_cdf_test ( ) call binomial_sample_test ( ) call birthday_cdf_test ( ) call birthday_sample_test ( ) call bradford_cdf_test ( ) call bradford_sample_test ( ) call buffon_box_pdf_test ( ) call buffon_box_sample_test ( ) call buffon_pdf_test ( ) call buffon_sample_test ( ) call burr_cdf_test ( ) call burr_sample_test ( ) call cardioid_cdf_test ( ) call cardioid_sample_test ( ) call cauchy_cdf_test ( ) call cauchy_sample_test ( ) call chebyshev1_cdf_test ( ) call chebyshev1_sample_test ( ) call chi_cdf_test ( ) call chi_sample_test ( ) call chi_square_cdf_test ( ) call chi_square_sample_test ( ) call chi_square_noncentral_sample_test ( ) call circular_normal_01_sample_test ( ) call circular_normal_sample_test ( ) call cosine_cdf_test ( ) call cosine_sample_test ( ) call coupon_complete_pdf_test ( ) call coupon_sample_test ( ) call deranged_cdf_test ( ) call deranged_sample_test ( ) call dipole_cdf_test ( ) call dipole_sample_test ( ) call dirichlet_sample_test ( ) call dirichlet_pdf_test ( ) call dirichlet_mix_sample_test ( ) call dirichlet_mix_pdf_test ( ) call discrete_cdf_test ( ) call discrete_sample_test ( ) call disk_sample_test ( ) call empirical_discrete_cdf_test ( ) call empirical_discrete_sample_test ( ) call english_letter_cdf_test ( ) call english_sentence_length_cdf_test ( ) call english_sentence_length_sample_test ( ) call english_word_length_cdf_test ( ) call english_word_length_sample_test ( ) call erlang_cdf_test ( ) call erlang_sample_test ( ) call exponential_cdf_test ( ) call exponential_sample_test ( ) call exponential_01_cdf_test ( ) call exponential_01_sample_test ( ) call extreme_values_cdf_test ( ) call extreme_values_sample_test ( ) call f_cdf_test ( ) call f_sample_test ( ) call fermi_dirac_sample_test ( ) call fisher_pdf_test ( ) call fisk_cdf_test ( ) call fisk_sample_test ( ) call folded_normal_cdf_test ( ) call folded_normal_sample_test ( ) call frechet_cdf_test ( ) call frechet_sample_test ( ) call gamma_cdf_test ( ) call gamma_sample_test ( ) call genlogistic_cdf_test ( ) call genlogistic_sample_test ( ) call geometric_cdf_test ( ) call geometric_sample_test ( ) call gompertz_cdf_test ( ) call gompertz_sample_test ( ) call gumbel_cdf_test ( ) call gumbel_sample_test ( ) call half_normal_cdf_test ( ) call half_normal_sample_test ( ) call hypergeometric_cdf_test ( ) call hypergeometric_sample_test ( ) call i4_choose_test ( ) call i4_choose_log_test ( ) call i4_is_power_of_10_test ( ) call i4_uniform_ab_test ( ) call i4vec_uniform_ab_test ( ) call i4vec_unique_count_test ( ) call inverse_gaussian_cdf_test ( ) call inverse_gaussian_sample_test ( ) call laplace_cdf_test ( ) call laplace_sample_test ( ) call levy_cdf_test ( ) call logistic_cdf_test ( ) call logistic_sample_test ( ) call log_normal_cdf_test ( ) call log_normal_sample_test ( ) call log_series_cdf_test ( ) call log_series_sample_test ( ) call log_uniform_cdf_test ( ) call log_uniform_sample_test ( ) call lorentz_cdf_test ( ) call lorentz_sample_test ( ) call maxwell_cdf_test ( ) call maxwell_sample_test ( ) call multinomial_coef_test ( ) call multinomial_sample_test ( ) call multinomial_pdf_test ( ) call multinoulli_pdf_test ( ) call nakagami_cdf_test ( ) call nakagami_sample_test ( ) call negative_binomial_cdf_test ( ) call negative_binomial_sample_test ( ) call normal_01_cdf_test ( ) call normal_01_samples_test ( ) call normal_cdf_test ( ) call normal_samples_test ( ) call normal_truncated_ab_cdf_test ( ) call normal_truncated_ab_sample_test ( ) call normal_truncated_a_cdf_test ( ) call normal_truncated_a_sample_test ( ) call normal_truncated_b_cdf_test ( ) call normal_truncated_b_sample_test ( ) call pareto_cdf_test ( ) call pareto_sample_test ( ) call pearson_05_pdf_test ( ) call planck_pdf_test ( ) call planck_sample_test ( ) call poisson_cdf_test ( ) call poisson_sample_test ( ) call power_cdf_test ( ) call power_sample_test ( ) call quasigeometric_cdf_test ( ) call quasigeometric_sample_test ( ) call r8_beta_test ( ) call r8_ceiling_test ( ) call r8_error_f_test ( ) call r8_factorial_test ( ) call r8_gamma_inc_test ( ) call r8_gamma_log_int_test ( ) call r8_zeta_test ( ) call rayleigh_cdf_test ( ) call rayleigh_sample_test ( ) call reciprocal_cdf_test ( ) call reciprocal_sample_test ( ) call runs_pdf_test ( ) call runs_sample_test ( ) call sech_cdf_test ( ) call sech_sample_test ( ) call semicircular_cdf_test ( ) call semicircular_sample_test ( ) call student_cdf_test ( ) call student_sample_test ( ) call student_noncentral_cdf_test ( ) call tfn_test ( ) call triangle_cdf_test ( ) call triangle_sample_test ( ) call triangular_cdf_test ( ) call triangular_sample_test ( ) call uniform_01_order_sample_test ( ) call uniform_nsphere_sample_test ( ) call uniform_01_cdf_test ( ) call uniform_01_sample_test ( ) call uniform_cdf_test ( ) call uniform_sample_test ( ) call uniform_discrete_cdf_test ( ) call uniform_discrete_sample_test ( ) call von_mises_cdf_test ( ) call von_mises_sample_test ( ) call weibull_cdf_test ( ) call weibull_sample_test ( ) call weibull_discrete_cdf_test ( ) call weibull_discrete_sample_test ( ) call zipf_cdf_test ( ) call zipf_sample_test ( ) ! ! Terminate. ! write ( *, '(a)' ) '' write ( *, '(a)' ) 'prob_test():' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) '' call timestamp ( ) stop 0 end subroutine angle_cdf_test ( ) !*****************************************************************************80 ! !! angle_cdf_test() tests angle_cdf(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer n real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'angle_cdf_test():' write ( *, '(a)' ) ' angle_cdf() evaluates the Angle CDF;' n = 5 x = 0.50D+00 call angle_cdf ( x, n, cdf ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter N = ', n write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' CDF value = ', cdf return end subroutine angle_pdf_test ( ) !*****************************************************************************80 ! !! ANGLE_PDF_test() tests ANGLE_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer n real ( kind = rk ) pdf real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'ANGLE_PDF_test():' write ( *, '(a)' ) ' ANGLE_PDF evaluates the Angle PDF;' n = 5 x = 0.50D+00 call angle_pdf ( x, n, pdf ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter N = ', n write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value = ', pdf return end subroutine angle_mean_test ( ) !*****************************************************************************80 ! !! ANGLE_MEAN_test() tests ANGLE_MEAN; ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) mean integer n write ( *, '(a)' ) '' write ( *, '(a)' ) 'ANGLE_MEAN_test():' write ( *, '(a)' ) ' ANGLE_mean() computes the Angle mean;' n = 5 call angle_mean ( n, mean ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter N = ', n write ( *, '(a,g14.6)' ) ' PDF mean = ', mean return end subroutine anglit_cdf_test ( ) !*****************************************************************************80 ! !! ANGLIT_CDF_test() tests ANGLIT_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'ANGLIT_CDF_test():' write ( *, '(a)' ) ' ANGLIT_CDF evaluates the Anglit CDF;' write ( *, '(a)' ) ' ANGLIT_CDF_INV inverts the Anglit CDF.' write ( *, '(a)' ) ' ANGLIT_PDF evaluates the Anglit PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call anglit_sample ( x ) call anglit_pdf ( x, pdf ) call anglit_cdf ( x, cdf ) call anglit_cdf_inv ( cdf, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine anglit_sample_test ( ) !*****************************************************************************80 ! !! ANGLIT_SAMPLE_test() tests ANGLIT_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'ANGLIT_SAMPLE_test():' write ( *, '(a)' ) ' ANGLIT_mean() computes the Anglit mean;' write ( *, '(a)' ) ' ANGLIT_sample() samples the Anglit distribution;' write ( *, '(a)' ) ' ANGLIT_variance() computes the Anglit variance.' call anglit_mean ( mean ) call anglit_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call anglit_sample ( x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine arcsin_cdf_test ( ) !*****************************************************************************80 ! !! ARCSIN_CDF_test() tests ARCSIN_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a logical arcsin_check real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'ARCSIN_CDF_test():' write ( *, '(a)' ) ' ARCSIN_CDF evaluates the Arcsin CDF;' write ( *, '(a)' ) ' ARCSIN_CDF_INV inverts the Arcsin CDF.' write ( *, '(a)' ) ' ARCSIN_PDF evaluates the Arcsin PDF;' a = 1.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. arcsin_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'ARCSIN_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call arcsin_sample ( a, x ) call arcsin_pdf ( x, a, pdf ) call arcsin_cdf ( x, a, cdf ) call arcsin_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine arcsin_sample_test ( ) !*****************************************************************************80 ! !! ARCSIN_SAMPLE_test() tests ARCSIN_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a logical arcsin_check integer i integer j real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'ARCSIN_SAMPLE_test():' write ( *, '(a)' ) ' ARCSIN_mean() computes the Arcsin mean;' write ( *, '(a)' ) ' ARCSIN_sample() samples the Arcsin distribution;' write ( *, '(a)' ) ' ARCSIN_variance() computes the Arcsin variance.' do i = 1, 2 if ( i == 1 ) then a = 1.0D+00 else if ( i == 2 ) then a = 16.0D+00 end if write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. arcsin_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'ARCSIN_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call arcsin_mean ( a, mean ) call arcsin_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do j = 1, sample_num call arcsin_sample ( a, x(j) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin end do return end subroutine benford_cdf_test ( ) !*****************************************************************************80 ! !! benford_cdf_test() tests benford_cdf(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 14 November 2022 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf real ( kind = rk ) cdf2 integer i integer n real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'benford_cdf_test():' write ( *, '(a)' ) ' benford_cdf() evaluates the CDF.' write ( *, '(a)' ) ' benford_cdf_invert() inverts the CDF.' write ( *, '(a)' ) ' benford_pdf() evaluates the PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' N CDF(N) CDF(N) by summing' write ( *, '(a)' ) '' cdf2 = 0.0D+00 do n = 1, 9 call benford_cdf ( n, cdf ) call benford_pdf ( n, pdf ) cdf2 = cdf2 + pdf write ( *, '(2x,i6,2x,g14.6,2x,g14.6)' ) n, cdf, cdf2 end do write ( *, '(a)' ) '' write ( *, '(a)' ) ' N CDF(N) CDF(N) by summing' write ( *, '(a)' ) '' cdf2 = 0.0D+00 do n = 10, 99 call benford_cdf ( n, cdf ) call benford_pdf ( n, pdf ) cdf2 = cdf2 + pdf write ( *, '(2x,i6,2x,g14.6,2x,g14.6)' ) n, cdf, cdf2 end do write ( *, '(a)' ) '' write ( *, '(a)' ) & ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call benford_sample ( x ) call benford_pdf ( x, pdf ) call benford_cdf ( x, cdf ) call benford_cdf_inv ( cdf, x2 ) write ( *, '(i6,2x,g14.6,2x,g14.6,2x,i6)' ) x, pdf, cdf, x2 end do return end subroutine benford_pdf_test ( ) !*****************************************************************************80 ! !! benford_pdf_test() tests benford_pdf(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 26 February 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer n real ( kind = rk ) pdf write ( *, '(a)' ) '' write ( *, '(a)' ) 'benford_pdf_test():' write ( *, '(a)' ) ' benford_pdf() evaluates the PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' N PDF(N)' write ( *, '(a)' ) '' do n = 1, 9 call benford_pdf ( n, pdf ) write ( *, '(2x,i6,2x,g14.6)' ) n, pdf end do write ( *, '(a)' ) '' write ( *, '(a)' ) ' N PDF(N)' write ( *, '(a)' ) '' do n = 10, 99 call benford_pdf ( n, pdf ) write ( *, '(2x,i6,2x,g14.6)' ) n, pdf end do return end subroutine benford_sample_test ( ) !*****************************************************************************80 ! !! benford_sample_test() tests benford_sample(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 14 November 2022 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'benford_sample_test():' write ( *, '(a)' ) ' benford_mean() computes the mean;' write ( *, '(a)' ) ' benford_sample() samples the distribution;' write ( *, '(a)' ) ' benford_variance() computes the variance.' call benford_mean ( mean ) call benford_variance ( variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call benford_sample ( x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine bernoulli_cdf_test ( ) !*****************************************************************************80 ! !! bernoulli_cdf_test() tests bernoulli_cdf(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a logical bernoulli_check real ( kind = rk ) cdf integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BERNOULLI_CDF_test():' write ( *, '(a)' ) ' BERNOULLI_CDF evaluates the Bernoulli CDF;' write ( *, '(a)' ) ' BERNOULLI_CDF_INV inverts the Bernoulli CDF.' write ( *, '(a)' ) ' BERNOULLI_PDF evaluates the Bernoulli PDF;' a = 0.75D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. bernoulli_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call bernoulli_sample ( a, x ) call bernoulli_pdf ( x, a, pdf ) call bernoulli_cdf ( x, a, cdf ) call bernoulli_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine bernoulli_sample_test ( ) !*****************************************************************************80 ! !! bernoulli_sample_test() tests bernoulli_sample(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a logical bernoulli_check integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'BERNOULLI_SAMPLE_test():' write ( *, '(a)' ) ' BERNOULLI_mean() computes the Bernoulli mean;' write ( *, '(a)' ) ' BERNOULLI_sample() samples the Bernoulli distribution;' write ( *, '(a)' ) ' BERNOULLI_variance() computes the Bernoulli variance.' a = 0.75D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. bernoulli_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BERNOULLI_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call bernoulli_mean ( a, mean ) call bernoulli_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call bernoulli_sample ( a, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine bessel_i0_test ( ) !*****************************************************************************80 ! !! BESSEL_I0_test() tests BESSEL_I0. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) bessel_i0 real ( kind = rk ) fx real ( kind = rk ) fx2 integer n_data real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'BESSEL_I0_TEST:' write ( *, '(a)' ) ' BESSEL_I0 evaluates the Bessel I0 function.' write ( *, '(a)' ) '' write ( *, '(a)' ) & ' X Exact BESSEL_I0(X)' write ( *, '(a)' ) '' n_data = 0 do call bessel_i0_values ( n_data, x, fx ) if ( n_data == 0 ) then exit end if fx2 = bessel_i0 ( x ) write ( *, '(2x,f14.6,2x,g24.16,2x,g24.16)' ) x, fx, fx2 end do return end subroutine bessel_i1_test ( ) !*****************************************************************************80 ! !! BESSEL_I1_test() tests BESSEL_I1. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) bessel_i1 real ( kind = rk ) fx real ( kind = rk ) fx2 integer n_data real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'BESSEL_I1_TEST:' write ( *, '(a)' ) ' BESSEL_I1 evaluates the Bessel I1 function.' write ( *, '(a)' ) '' write ( *, '(a)' ) & ' X Exact BESSEL_I1(X)' write ( *, '(a)' ) '' n_data = 0 do call bessel_i1_values ( n_data, x, fx ) if ( n_data == 0 ) then exit end if fx2 = bessel_i1 ( x ) write ( *, '(2x,f14.6,2x,g24.16,2x,g24.16)' ) x, fx, fx2 end do return end subroutine beta_cdf_test ( ) !*****************************************************************************80 ! !! BETA_CDF_test() tests BETA_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 April 2013 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b logical beta_check real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_CDF_test():' write ( *, '(a)' ) ' BETA_CDF evaluates the Beta CDF;' write ( *, '(a)' ) ' BETA_CDF_INV inverts the Beta CDF.' write ( *, '(a)' ) ' BETA_PDF evaluates the Beta PDF;' a = 12.0D+00 b = 12.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. beta_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' A B X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call beta_sample ( a, b, x ) call beta_pdf ( x, a, b, pdf ) call beta_cdf ( x, a, b, cdf ) call beta_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,6g14.6)' ) a, b, x, pdf, cdf, x2 end do return end subroutine beta_inc_test ( ) !*****************************************************************************80 ! !! BETA_INC_test() tests BETA_INC. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) beta_inc real ( kind = rk ) fx real ( kind = rk ) fx2 integer n_data real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_INC_TEST:' write ( *, '(a)' ) ' BETA_INC evaluates the normalized incomplete Beta' write ( *, '(a)' ) ' function BETA_INC(A,B,X).' write ( *, '(a)' ) '' write ( *, '(a)' ) ' A B X Exact F BETA_INC(A,B,X)' write ( *, '(a)' ) '' n_data = 0 do call beta_inc_values ( n_data, a, b, x, fx ) if ( n_data == 0 ) then exit end if fx2 = beta_inc ( a, b, x ) write ( *, '(2x,3f8.4,2g14.6)' ) a, b, x, fx, fx2 end do return end subroutine beta_sample_test ( ) !*****************************************************************************80 ! !! BETA_SAMPLE_test() tests BETA_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical beta_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_SAMPLE_TEST:' write ( *, '(a)' ) ' BETA_mean() computes the Beta mean;' write ( *, '(a)' ) ' BETA_sample() samples the Beta distribution;' write ( *, '(a)' ) ' BETA_variance() computes the Beta variance.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. beta_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call beta_mean ( a, b, mean ) call beta_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call beta_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine beta_binomial_cdf_test ( ) !*****************************************************************************80 ! !! BETA_BINOMIAL_CDF_test() tests BETA_BINOMIAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b logical beta_binomial_check integer c real ( kind = rk ) cdf integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_BINOMIAL_CDF_test():' write ( *, '(a)' ) ' BETA_BINOMIAL_CDF evaluates the Beta Binomial CDF;' write ( *, '(a)' ) ' BETA_BINOMIAL_CDF_INV inverts the Beta Binomial CDF.' write ( *, '(a)' ) ' BETA_BINOMIAL_PDF evaluates the Beta Binomial PDF;' a = 2.0D+00 b = 3.0D+00 c = 4 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i8)' ) ' PDF parameter C = ', c if ( .not. beta_binomial_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_BINOMIAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call beta_binomial_sample ( a, b, c, x ) call beta_binomial_pdf ( x, a, b, c, pdf ) call beta_binomial_cdf ( x, a, b, c, cdf ) call beta_binomial_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine beta_binomial_sample_test ( ) !*****************************************************************************80 ! !! BETA_BINOMIAL_SAMPLE_test() tests BETA_BINOMIAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical beta_binomial_check integer c integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_BINOMIAL_SAMPLE_test():' write ( *, '(a)' ) ' BETA_BINOMIAL_mean() computes the Beta Binomial mean;' write ( *, '(a)' ) ' BETA_BINOMIAL_sample() samples the Beta Binomial distribution;' write ( *, '(a)' ) ' BETA_BINOMIAL_variance() computes the Beta Binomial variance.' a = 2.0D+00 b = 3.0D+00 c = 4 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i8)' ) ' PDF parameter C = ', c if ( .not. beta_binomial_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BETA_BINOMIAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call beta_binomial_mean ( a, b, c, mean ) call beta_binomial_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call beta_binomial_sample ( a, b, c, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine binomial_cdf_test ( ) !*****************************************************************************80 ! !! BINOMIAL_CDF_test() tests BINOMIAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer a real ( kind = rk ) b logical binomial_check real ( kind = rk ) cdf integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BINOMIAL_CDF_test():' write ( *, '(a)' ) ' BINOMIAL_CDF evaluates the Binomial CDF;' write ( *, '(a)' ) ' BINOMIAL_CDF_INV inverts the Binomial CDF.' write ( *, '(a)' ) ' BINOMIAL_PDF evaluates the Binomial PDF;' a = 5 b = 0.65D+00 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. binomial_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BINOMIAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call binomial_sample ( a, b, x ) call binomial_pdf ( x, a, b, pdf ) call binomial_cdf ( x, a, b, cdf ) call binomial_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine binomial_sample_test ( ) !*****************************************************************************80 ! !! BINOMIAL_SAMPLE_test() tests BINOMIAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer a real ( kind = rk ) b logical binomial_check integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'BINOMIAL_SAMPLE_test():' write ( *, '(a)' ) ' BINOMIAL_mean() computes the Binomial mean;' write ( *, '(a)' ) ' BINOMIAL_sample() samples the Binomial distribution;' write ( *, '(a)' ) ' BINOMIAL_variance() computes the Binomial variance.' a = 5 b = 0.30D+00 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. binomial_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BINOMIAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call binomial_mean ( a, b, mean ) call binomial_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call binomial_sample ( a, b, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine birthday_cdf_test ( ) !*****************************************************************************80 ! !! BIRTHDAY_CDF_test() tests BIRTHDAY_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer n integer n2 real ( kind = rk ) pdf write ( *, '(a)' ) '' write ( *, '(a)' ) 'BIRTHDAY_CDF_test():' write ( *, '(a)' ) ' BIRTHDAY_CDF evaluates the Birthday CDF;' write ( *, '(a)' ) ' BIRTHDAY_CDF_INV inverts the Birthday CDF.' write ( *, '(a)' ) ' BIRTHDAY_PDF evaluates the Birthday PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' N PDF CDF CDF_INV' write ( *, '(a)' ) '' do n = 1, 30 call birthday_pdf ( n, pdf ) call birthday_cdf ( n, cdf ) call birthday_cdf_inv ( cdf, n2 ) write ( *, '(2x,i8,2x,g14.6,2x,g14.6,2x,i8)' ) n, pdf, cdf, n2 end do return end subroutine birthday_sample_test ( ) !*****************************************************************************80 ! !! BIRTHDAY_SAMPLE_test() tests BIRTHDAY_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: nsample = 10000 integer i integer n real ( kind = rk ) mean real ( kind = rk ) pdf integer x(nsample) write ( *, '(a)' ) '' write ( *, '(a)' ) 'BIRTHDAY_SAMPLE_test():' write ( *, '(a)' ) ' BIRTHDAY_sample() samples the Birthday distribution.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' N Mean PDF' write ( *, '(a)' ) '' do n = 10, 40 do i = 1, nsample call birthday_sample ( n, x(i) ) end do call i4vec_mean ( nsample, x, mean ) call birthday_pdf ( n, pdf ) write ( *, '(2x,i2,2x,g14.6,2x,g14.6)' ) n, mean, pdf end do return end subroutine bradford_cdf_test ( ) !*****************************************************************************80 ! !! BRADFORD_CDF_test() tests BRADFORD_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b logical bradford_check real ( kind = rk ) c real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BRADFORD_CDF_test():' write ( *, '(a)' ) ' BRADFORD_CDF evaluates the Bradford CDF;' write ( *, '(a)' ) ' BRADFORD_CDF_INV inverts the Bradford CDF.' write ( *, '(a)' ) ' BRADFORD_PDF evaluates the Bradford PDF;' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. bradford_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BRADFORD_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call bradford_sample ( a, b, c, x ) call bradford_pdf ( x, a, b, c, pdf ) call bradford_cdf ( x, a, b, c, cdf ) call bradford_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine bradford_sample_test ( ) !*****************************************************************************80 ! !! BRADFORD_SAMPLE_test() tests BRADFORD_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical bradford_check real ( kind = rk ) c integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'BRADFORD_SAMPLE_test():' write ( *, '(a)' ) ' BRADFORD_mean() computes the Bradford mean;' write ( *, '(a)' ) ' BRADFORD_sample() samples the Bradford distribution;' write ( *, '(a)' ) ' BRADFORD_variance() computes Bradford the variance.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. bradford_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BRADFORD_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call bradford_mean ( a, b, c, mean ) call bradford_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call bradford_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine buffon_box_pdf_test ( ) !*****************************************************************************80 ! !! BUFFON_BOX_PDF_test() tests BUFFON_BOX_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b integer i integer j integer k real ( kind = rk ) l real ( kind = rk ) pdf write ( *, '(a)' ) '' write ( *, '(a)' ) 'BUFFON_BOX_PDF_test():' write ( *, '(a)' ) ' BUFFON_BOX_PDF evaluates the Buffon-Laplace PDF,' write ( *, '(a)' ) ' the probability that, on a grid of cells of width A' write ( *, '(a)' ) ' and height B, a needle of length L, dropped at random,' write ( *, '(a)' ) ' will cross at least one grid line.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' A B L PDF' write ( *, '(a)' ) '' do i = 1, 5 a = real ( i, kind = rk ) do j = 1, 5 b = real ( j, kind = rk ) do k = 0, 5 l = real ( k, kind = rk ) * min ( a, b ) / 5.0D+00 call buffon_box_pdf ( a, b, l, pdf ) write ( *, '(2x,f8.4,2x,f8.4,2x,f8.4,2x,g14.6)' ) a, b, l, pdf end do write ( *, '(a)' ) '' end do end do return end subroutine buffon_box_sample_test ( ) !*****************************************************************************80 ! !! BUFFON_BOX_SAMPLE_test() tests BUFFON_BOX_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 10 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: test_num = 4 real ( kind = rk ) a real ( kind = rk ) b integer buffon_box_sample real ( kind = rk ) err integer hits real ( kind = rk ) l real ( kind = rk ), parameter :: pi = 3.141592653589793238462643D+00 real ( kind = rk ) pi_est integer test integer trial_num integer, dimension ( test_num ) :: trial_num_test = (/ & 10, 100, 10000, 1000000 /) a = 1.0D+00 b = 1.0D+00 l = 1.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BUFFON_BOX_SAMPLE_test():' write ( *, '(a)' ) ' BUFFON_BOX_SAMPLE simulates a Buffon-Laplace' write ( *, '(a)' ) ' needle dropping experiment. On a grid of cells of ' write ( *, '(a)' ) ' width A and height B, a needle of length L is dropped' write ( *, '(a)' ) ' at random. We count the number of times it crosses' write ( *, '(a)' ) ' at least one grid line, and use this to estimate ' write ( *, '(a)' ) ' the value of PI.' write ( *, '(a)' ) '' write ( *, '(a,f14.6)' ) ' Cell width A = ', a write ( *, '(a,f14.6)' ) ' Cell height B = ', b write ( *, '(a,f14.6)' ) ' Needle length L = ', l write ( *, '(a)' ) '' write ( *, '(a)' ) ' Trials Hits Est(Pi) Err' write ( *, '(a)' ) '' do test = 1, test_num trial_num = trial_num_test(test) hits = buffon_box_sample ( a, b, l, trial_num ) if ( 0 < hits ) then pi_est = ( 2.0D+00 * l * ( a + b ) - l * l ) & * real ( trial_num, kind = rk ) & / ( a * b * real ( hits, kind = rk ) ) else pi_est = huge ( pi_est ) end if err = abs ( pi_est - pi ) write ( *, '(2x,i8,2x,i8,2x,f14.6,2x,g14.6)' ) trial_num, hits, pi_est, err end do return end subroutine buffon_pdf_test ( ) !*****************************************************************************80 ! !! BUFFON_PDF_test() tests BUFFON_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 10 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a integer i integer k real ( kind = rk ) l real ( kind = rk ) pdf write ( *, '(a)' ) '' write ( *, '(a)' ) 'BUFFON_PDF_test():' write ( *, '(a)' ) ' BUFFON_PDF evaluates the Buffon PDF,' write ( *, '(a)' ) ' the probability that, on a grid of cells of width A,' write ( *, '(a)' ) ' a needle of length L, dropped at random,' write ( *, '(a)' ) ' will cross at least one grid line.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' A L PDF' write ( *, '(a)' ) '' do i = 1, 5 a = real ( i, kind = rk ) do k = 0, 5 l = real ( k, kind = rk ) * a / 5.0D+00 call buffon_pdf ( a, l, pdf ) write ( *, '(2x,f8.4,2x,f8.4,2x,g14.6)' ) a, l, pdf end do write ( *, '(a)' ) '' end do return end subroutine buffon_sample_test ( ) !*****************************************************************************80 ! !! BUFFON_SAMPLE_test() tests BUFFON_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 10 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: test_num = 4 real ( kind = rk ) a integer buffon_sample real ( kind = rk ) err integer hits real ( kind = rk ) l real ( kind = rk ), parameter :: pi = 3.141592653589793238462643D+00 real ( kind = rk ) pi_est integer test integer trial_num integer, dimension ( test_num ) :: trial_num_test = (/ & 10, 100, 10000, 1000000 /) a = 1.0D+00 l = 1.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BUFFON_SAMPLE_test():' write ( *, '(a)' ) ' BUFFON_SAMPLE simulates a Buffon-Laplace' write ( *, '(a)' ) ' needle dropping experiment. On a grid of cells of ' write ( *, '(a)' ) ' width A, a needle of length L is dropped' write ( *, '(a)' ) ' at random. We count the number of times it crosses' write ( *, '(a)' ) ' at least one grid line, and use this to estimate ' write ( *, '(a)' ) ' the value of PI.' write ( *, '(a)' ) '' write ( *, '(a,f14.6)' ) ' Cell width A = ', a write ( *, '(a,f14.6)' ) ' Needle length L = ', l write ( *, '(a)' ) '' write ( *, '(a)' ) ' Trials Hits Est(Pi) Err' write ( *, '(a)' ) '' do test = 1, test_num trial_num = trial_num_test(test) hits = buffon_sample ( a, l, trial_num ) if ( 0 < hits ) then pi_est = ( 2.0D+00 * l ) * real ( trial_num, kind = rk ) & / ( a * real ( hits, kind = rk ) ) else pi_est = huge ( pi_est ) end if err = abs ( pi_est - pi ) write ( *, '(2x,i8,2x,i8,2x,f14.6,2x,g14.6)' ) trial_num, hits, pi_est, err end do return end subroutine burr_cdf_test ( ) !*****************************************************************************80 ! !! BURR_CDF_test() tests BURR_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b logical burr_check real ( kind = rk ) c real ( kind = rk ) cdf real ( kind = rk ) d integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'BURR_CDF_test():' write ( *, '(a)' ) ' BURR_CDF evaluates the Burr CDF;' write ( *, '(a)' ) ' BURR_CDF_INV inverts the Burr CDF.' write ( *, '(a)' ) ' BURR_PDF evaluates the Burr PDF;' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 d = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c write ( *, '(a,g14.6)' ) ' PDF parameter D = ', d if ( .not. burr_check ( a, b, c, d ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BURR_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call burr_sample ( a, b, c, d, x ) call burr_pdf ( x, a, b, c, d, pdf ) call burr_cdf ( x, a, b, c, d, cdf ) call burr_cdf_inv ( cdf, a, b, c, d, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine burr_sample_test ( ) !*****************************************************************************80 ! !! BURR_SAMPLE_test() tests BURR_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical burr_check real ( kind = rk ) c real ( kind = rk ) d integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'BURR_SAMPLE_test():' write ( *, '(a)' ) ' BURR_mean() computes the Burr mean;' write ( *, '(a)' ) ' BURR_variance() computes the Burr variance;' write ( *, '(a)' ) ' BURR_sample() samples the Burr distribution;' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 d = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c write ( *, '(a,g14.6)' ) ' PDF parameter D = ', d if ( .not. burr_check ( a, b, c, d ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'BURR_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call burr_mean ( a, b, c, d, mean ) call burr_variance ( a, b, c, d, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call burr_sample ( a, b, c, d, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine cardioid_cdf_test ( ) !*****************************************************************************80 ! !! CARDIOID_CDF_test() tests CARDIOID_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 31 July 2005 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) :: a = 0.0D+00 real ( kind = rk ) :: b = 0.25D+00 logical cardioid_check real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'CARDIOID_CDF_test():' write ( *, '(a)' ) ' CARDIOID_CDF evaluates the Cardioid CDF;' write ( *, '(a)' ) ' CARDIOID_CDF_INV inverts the Cardioid CDF.' write ( *, '(a)' ) ' CARDIOID_PDF evaluates the Cardioid PDF;' write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. cardioid_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CARDIOID_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call cardioid_sample ( a, b, x ) call cardioid_pdf ( x, a, b, pdf ) call cardioid_cdf ( x, a, b, cdf ) call cardioid_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine cardioid_sample_test ( ) !*****************************************************************************80 ! !! CARDIOID_SAMPLE_test() tests CARDIOID_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) :: a = 0.0D+00 real ( kind = rk ) :: b = 0.25D+00 logical cardioid_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'CARDIOID_SAMPLE_test():' write ( *, '(a)' ) ' CARDIOID_mean() computes the Cardioid mean;' write ( *, '(a)' ) ' CARDIOID_sample() samples the Cardioid distribution;' write ( *, '(a)' ) ' CARDIOID_variance() computes the Cardioid variance.' write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. cardioid_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CARDIOID_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call cardioid_mean ( a, b, mean ) call cardioid_variance ( a, b, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call cardioid_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine cauchy_cdf_test ( ) !*****************************************************************************80 ! !! CAUCHY_CDF_test() tests CAUCHY_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b logical cauchy_check real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'CAUCHY_CDF_test():' write ( *, '(a)' ) ' CAUCHY_CDF evaluates the Cauchy CDF;' write ( *, '(a)' ) ' CAUCHY_CDF_INV inverts the Cauchy CDF.' write ( *, '(a)' ) ' CAUCHY_PDF evaluates the Cauchy PDF;' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. cauchy_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CAUCHY_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call cauchy_sample ( a, b, x ) call cauchy_pdf ( x, a, b, pdf ) call cauchy_cdf ( x, a, b, cdf ) call cauchy_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine cauchy_sample_test ( ) !*****************************************************************************80 ! !! CAUCHY_SAMPLE_test() tests CAUCHY_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical cauchy_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'CAUCHY_SAMPLE_test():' write ( *, '(a)' ) ' CAUCHY_mean() computes the Cauchy mean;' write ( *, '(a)' ) ' CAUCHY_variance() computes the Cauchy variance;' write ( *, '(a)' ) ' CAUCHY_sample() samples the Cauchy distribution.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. cauchy_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CAUCHY_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call cauchy_mean ( a, b, mean ) call cauchy_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call cauchy_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine chebyshev1_cdf_test ( ) !*****************************************************************************80 ! !! CHEBYSHEV1_CDF_test() tests CHEBYSHEV1_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 01 August 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) chebyshev1_sample real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHEBYSHEV1_CDF_test():' write ( *, '(a)' ) ' CHEBYSHEV1_CDF evaluates the Chebyshev1 CDF;' write ( *, '(a)' ) ' CHEBYSHEV1_CDF_INV inverts the Chebyshev1 CDF.' write ( *, '(a)' ) ' CHEBYSHEV1_PDF evaluates the Chebyshev1 PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 x = chebyshev1_sample ( ) call chebyshev1_pdf ( x, pdf ) call chebyshev1_cdf ( x, cdf ) call chebyshev1_cdf_inv ( cdf, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine chebyshev1_sample_test ( ) !*****************************************************************************80 ! !! CHEBYSHEV1_SAMPLE_test() tests CHEBYSHEV1_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 01 August 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) chebyshev1_sample real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHEBYSHEV1_SAMPLE_test():' write ( *, '(a)' ) ' CHEBYSHEV1_mean() computes the Chebyshev1 mean;' write ( *, '(a)' ) ' CHEBYSHEV1_sample() samples the Chebyshev1 distribution;' write ( *, '(a)' ) ' CHEBYSHEV1_variance() computes the Chebyshev1 variance.' call chebyshev1_mean ( mean ) call chebyshev1_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num x(i) = chebyshev1_sample ( ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine chi_cdf_test ( ) !*****************************************************************************80 ! !! CHI_CDF_test() tests CHI_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf logical chi_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_CDF_test():' write ( *, '(a)' ) ' CHI_CDF evaluates the Chi CDF.' write ( *, '(a)' ) ' CHI_CDF_INV inverts the Chi CDF.' write ( *, '(a)' ) ' CHI_PDF evaluates the Chi PDF.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. chi_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call chi_sample ( a, b, c, x ) call chi_pdf ( x, a, b, c, pdf ) call chi_cdf ( x, a, b, c, cdf ) call chi_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine chi_sample_test ( ) !*****************************************************************************80 ! !! CHI_SAMPLE_test() tests CHI_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c logical chi_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SAMPLE_test():' write ( *, '(a)' ) ' CHI_mean() computes the Chi mean;' write ( *, '(a)' ) ' CHI_variance() computes the Chi variance;' write ( *, '(a)' ) ' CHI_sample() samples the Chi distribution.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. chi_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call chi_mean ( a, b, c, mean ) call chi_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call chi_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine chi_square_cdf_test ( ) !*****************************************************************************80 ! !! CHI_SQUARE_CDF_test() tests CHI_SQUARE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf logical chi_square_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SQUARE_CDF_test():' write ( *, '(a)' ) ' CHI_SQUARE_CDF evaluates the Chi Square CDF;' write ( *, '(a)' ) ' CHI_SQUARE_CDF_INV inverts the Chi Square CDF.' write ( *, '(a)' ) ' CHI_SQUARE_PDF evaluates the Chi Square PDF;' a = 4.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. chi_square_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SQUARE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call chi_square_sample ( a, x ) call chi_square_pdf ( x, a, pdf ) call chi_square_cdf ( x, a, cdf ) call chi_square_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine chi_square_sample_test ( ) !*****************************************************************************80 ! !! CHI_SQUARE_SAMPLE_test() tests CHI_SQUARE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a logical chi_square_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SQUARE_SAMPLE_test():' write ( *, '(a)' ) ' CHI_SQUARE_mean() computes the Chi Square mean;' write ( *, '(a)' ) ' CHI_SQUARE_sample() samples the Chi Square distribution;' write ( *, '(a)' ) ' CHI_SQUARE_variance() computes the Chi Square variance.' a = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. chi_square_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SQUARE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call chi_square_mean ( a, mean ) call chi_square_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call chi_square_sample ( a, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine chi_square_noncentral_sample_test ( ) !*****************************************************************************80 ! !! CHI_SQUARE_NONCENTRAL_SAMPLE_test() tests CHI_SQUARE_NONCENTRAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical chi_square_noncentral_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SQUARE_NONCENTRAL_SAMPLE_test():' write ( *, '(a)' ) ' CHI_SQUARE_NONCENTRAL_mean() computes the Chi Square Noncentral mean.' write ( *, '(a)' ) ' CHI_SQUARE_NONCENTRAL_sample() samples the Chi Square Noncentral distribution.' write ( *, '(a)' ) ' CHI_SQUARE_NONCENTRAL_variance() computes the Chi Square Noncentral variance.' a = 3.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. chi_square_noncentral_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'CHI_SQUARE_NONCENTRAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call chi_square_noncentral_mean ( a, b, mean ) call chi_square_noncentral_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call chi_square_noncentral_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine circular_normal_01_sample_test ( ) !*****************************************************************************80 ! !! CIRCULAR_NORMAL_01_SAMPLE_test() tests CIRCULAR_NORMAL_01_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i integer j real ( kind = rk ) mean(2) real ( kind = rk ) variance(2) real ( kind = rk ) x(2) real ( kind = rk ) x_table(sample_num,2) real ( kind = rk ) xmax(2) real ( kind = rk ) xmin(2) write ( *, '(a)' ) '' write ( *, '(a)' ) 'CIRCULAR_NORMAL_01_SAMPLE_test():' write ( *, '(a)' ) ' CIRCULAR_NORMAL_01_mean() computes the Circular Normal 01 mean;' write ( *, '(a)' ) ' CIRCULAR_NORMAL_01_sample() samples the Circular Normal 01 distribution;' write ( *, '(a)' ) ' CIRCULAR_NORMAL_01_variance() computes the Circular Normal 01 variance.' call circular_normal_01_mean ( mean ) call circular_normal_01_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,2g14.6)' ) ' PDF means = ', mean(1:2) write ( *, '(a,2g14.6)' ) ' PDF variances = ', variance(1:2) do i = 1, sample_num call circular_normal_01_sample ( x ) x_table(i,1) = x(1) x_table(i,2) = x(2) end do do j = 1, 2 call r8vec_mean ( sample_num, x_table(1,j), mean(j) ) call r8vec_variance ( sample_num, x_table(1,j), variance(j) ) call r8vec_max ( sample_num, x_table(1,j), xmax(j) ) call r8vec_min ( sample_num, x_table(1,j), xmin(j) ) end do write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,2g14.6)' ) ' Sample mean = ', mean(1:2) write ( *, '(a,2g14.6)' ) ' Sample variance = ', variance(1:2) write ( *, '(a,2g14.6)' ) ' Sample maximum = ', xmax(1:2) write ( *, '(a,2g14.6)' ) ' Sample minimum = ', xmin(1:2) return end subroutine circular_normal_sample_test ( ) !*****************************************************************************80 ! !! CIRCULAR_NORMAL_SAMPLE_test() tests CIRCULAR_NORMAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 January 2012 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a(2) real ( kind = rk ) b integer i integer j real ( kind = rk ) mean(2) real ( kind = rk ) variance(2) real ( kind = rk ) x(2) real ( kind = rk ) x_table(sample_num,2) real ( kind = rk ) xmax(2) real ( kind = rk ) xmin(2) a(1) = 1.0D+00 a(2) = 5.0D+00 b = 0.75D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'CIRCULAR_NORMAL_SAMPLE_test():' write ( *, '(a)' ) ' CIRCULAR_NORMAL_mean() computes the Circular Normal mean;' write ( *, '(a)' ) ' CIRCULAR_NORMAL_sample() samples the Circular Normal distribution;' write ( *, '(a)' ) ' CIRCULAR_NORMAL_variance() computes the Circular Normal variance.' call circular_normal_mean ( a, b, mean ) call circular_normal_variance ( a, b, variance ) write ( *, '(a)' ) '' write ( *, '(a,2g14.6)' ) ' PDF means = ', mean(1:2) write ( *, '(a,2g14.6)' ) ' PDF variances = ', variance(1:2) do i = 1, sample_num call circular_normal_sample ( a, b, x ) x_table(i,1) = x(1) x_table(i,2) = x(2) end do do j = 1, 2 call r8vec_mean ( sample_num, x_table(1,j), mean(j) ) call r8vec_variance ( sample_num, x_table(1,j), variance(j) ) call r8vec_max ( sample_num, x_table(1,j), xmax(j) ) call r8vec_min ( sample_num, x_table(1,j), xmin(j) ) end do write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,2g14.6)' ) ' Sample mean = ', mean(1:2) write ( *, '(a,2g14.6)' ) ' Sample variance = ', variance(1:2) write ( *, '(a,2g14.6)' ) ' Sample maximum = ', xmax(1:2) write ( *, '(a,2g14.6)' ) ' Sample minimum = ', xmin(1:2) return end subroutine cosine_cdf_test ( ) !*****************************************************************************80 ! !! COSINE_CDF_test() tests COSINE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf logical cosine_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'COSINE_CDF_test():' write ( *, '(a)' ) ' COSINE_CDF evaluates the Cosine CDF.' write ( *, '(a)' ) ' COSINE_CDF_INV inverts the Cosine CDF.' write ( *, '(a)' ) ' COSINE_PDF evaluates the Cosine PDF.' a = 2.0D+00 b = 1.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. cosine_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'COSINE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call cosine_sample ( a, b, x ) call cosine_pdf ( x, a, b, pdf ) call cosine_cdf ( x, a, b, cdf ) call cosine_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine cosine_sample_test ( ) !*****************************************************************************80 ! !! COSINE_SAMPLE_test() tests COSINE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical cosine_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'COSINE_SAMPLE_test():' write ( *, '(a)' ) ' COSINE_mean() computes the Cosine mean;' write ( *, '(a)' ) ' COSINE_sample() samples the Cosine distribution;' write ( *, '(a)' ) ' COSINE_variance() computes the Cosine variance.' a = 2.0D+00 b = 1.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. cosine_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'COSINE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call cosine_mean ( a, b, mean ) call cosine_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call cosine_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine coupon_complete_pdf_test ( ) !*****************************************************************************80 ! !! coupon_complete_pdf_test() tests coupon_complete_pdf(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer box_num real ( kind = rk ) cdf real ( kind = rk ) pdf integer type_num write ( *, '(a)' ) '' write ( *, '(a)' ) 'coupon_complete_pdf_test():' write ( *, '(a)' ) ' coupon_complete_pdf() evaluates the coupon collector''s' write ( *, '(a)' ) ' complete collection PDF.' do type_num = 2, 4 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Number of coupon types is ', type_num write ( *, '(a)' ) '' write ( *, '(a)' ) ' BOX_NUM PDF CDF' write ( *, '(a)' ) '' cdf = 0.0D+00 do box_num = 1, 20 call coupon_complete_pdf ( type_num, box_num, pdf ) cdf = cdf + pdf write ( *, '(2x,i8,2x,g14.6,2x,g14.6)' ) box_num, pdf, cdf end do end do return end subroutine coupon_sample_test ( ) !*****************************************************************************80 ! !! coupon_sample_test() tests coupon_sample(). ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n_trial = 10 integer, parameter :: max_type = 25 real ( kind = rk ) average integer coupon(max_type) real ( kind = rk ) expect integer i integer n_coupon integer n_type write ( *, '(a)' ) '' write ( *, '(a)' ) 'coupon_sample_test():' write ( *, '(a)' ) ' coupon_sample() samples the coupon PDF.' do n_type = 5, max_type, 5 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Number of coupon types is ', n_type expect = real ( n_type, kind = rk ) * log ( real ( n_type, kind = rk ) ) write ( *, '(a,g14.6)' ) ' Expected wait is about ', expect write ( *, '(a)' ) '' average = 0.0D+00 do i = 1, n_trial call coupon_sample ( n_type, coupon, n_coupon ) write ( *, '(2i5)' ) i, n_coupon average = average + real ( n_coupon, kind = rk ) end do average = average / real ( n_trial, kind = rk ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' Average wait was ', average end do return end subroutine deranged_cdf_test ( ) !*****************************************************************************80 ! !! DERANGED_CDF_test() tests DERANGED_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer a real ( kind = rk ) cdf logical deranged_check real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'DERANGED_CDF_test():' write ( *, '(a)' ) ' DERANGED_CDF evaluates the Deranged CDF;' write ( *, '(a)' ) ' DERANGED_CDF_INV inverts the Deranged CDF.' write ( *, '(a)' ) ' DERANGED_PDF evaluates the Deranged PDF;' a = 7 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a if ( .not. deranged_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DERANGED_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do x = 0, a call deranged_pdf ( x, a, pdf ) call deranged_cdf ( x, a, cdf ) call deranged_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine deranged_sample_test ( ) !*****************************************************************************80 ! !! DERANGED_SAMPLE_test() tests DERANGED_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer a logical deranged_check integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'DERANGED_SAMPLE_test():' write ( *, '(a)' ) ' DERANGED_mean() computes the Deranged mean.' write ( *, '(a)' ) ' DERANGED_variance() computes the Deranged variance.' write ( *, '(a)' ) ' DERANGED_sample() samples the Deranged distribution.' a = 7 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a if ( .not. deranged_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DERANGED_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call deranged_mean ( a, mean ) call deranged_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call deranged_sample ( a, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine dipole_cdf_test ( ) !*****************************************************************************80 ! !! DIPOLE_CDF_test() tests DIPOLE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: test_num = 3 real ( kind = rk ) a real ( kind = rk ) atest(test_num) real ( kind = rk ) b real ( kind = rk ) btest(test_num) real ( kind = rk ) cdf real ( kind = rk ) r8_pi logical dipole_check integer i integer itest real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIPOLE_CDF_test():' write ( *, '(a)' ) ' DIPOLE_CDF evaluates the Dipole CDF.' write ( *, '(a)' ) ' DIPOLE_CDF_INV inverts the Dipole CDF.' write ( *, '(a)' ) ' DIPOLE_PDF evaluates the Dipole PDF.' atest(1) = 0.0D+00 btest(1) = 1.0D+00 atest(2) = r8_pi() / 4.0D+00 btest(2) = 0.5D+00 atest(3) = r8_pi() / 2.0D+00 btest(3) = 0.0D+00 do itest = 1, test_num a = atest(itest) b = btest(itest) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. dipole_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIPOLE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call dipole_sample ( a, b, x ) call dipole_pdf ( x, a, b, pdf ) call dipole_cdf ( x, a, b, cdf ) call dipole_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do end do return end subroutine dipole_sample_test ( ) !*****************************************************************************80 ! !! DIPOLE_SAMPLE_test() tests DIPOLE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 August 2006 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 10000 integer, parameter :: test_num = 3 real ( kind = rk ) a real ( kind = rk ), dimension ( test_num ) :: a_test = (/ & 0.0D+00, 0.785398163397448D+00, 1.57079632679490D+00 /) real ( kind = rk ) b real ( kind = rk ), dimension ( test_num ) :: b_test = (/ & 1.0D+00, 0.5D+00, 0.0D+00 /) logical dipole_check integer i real ( kind = rk ) mean integer test real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIPOLE_SAMPLE_test():' write ( *, '(a)' ) ' DIPOLE_sample() samples the Dipole distribution.' do test = 1, test_num a = a_test(test) b = b_test(test) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. dipole_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIPOLE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if do i = 1, sample_num call dipole_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin end do return end subroutine dirichlet_sample_test ( ) !*****************************************************************************80 ! !! DIRICHLET_SAMPLE_test() tests DIRICHLET_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 13 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 3 integer, parameter :: sample_num = 1000 real ( kind = rk ) a(n) logical dirichlet_check integer i real ( kind = rk ) mean(n) real ( kind = rk ) m2(n,n) real ( kind = rk ) variance(n) real ( kind = rk ) x(n,sample_num) real ( kind = rk ) xmax(n) real ( kind = rk ) xmin(n) write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_SAMPLE_test():' write ( *, '(a)' ) ' DIRICHLET_sample() samples the Dirichlet distribution;' write ( *, '(a)' ) ' DIRICHLET_mean() computes the Dirichlet mean;' write ( *, '(a)' ) ' DIRICHLET_variance() computes the Dirichlet variance.' a(1:n) = (/ 0.250D+00, 0.500D+00, 1.250D+00 /) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Number of components N = ', n call r8vec_print ( n, a, ' PDF parameters A:' ) write ( *, '(a)' ) ' PDF parameters A(1:N):' if ( .not. dirichlet_check ( n, a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call dirichlet_mean ( n, a, mean ) call dirichlet_variance ( n, a, variance ) call r8vec_print ( n, mean, ' PDF mean:' ) call r8vec_print ( n, variance, ' PDF variance:' ) call dirichlet_moment2 ( n, a, m2 ) call r8mat_print ( n, n, m2, ' Second moments:' ) do i = 1, sample_num call dirichlet_sample ( n, a, x(1,i) ) end do call r8row_max ( n, sample_num, x, xmax ) call r8row_min ( n, sample_num, x, xmin ) call r8row_mean ( n, sample_num, x, mean ) call r8row_variance ( n, sample_num, x, variance ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a)' ) '' write ( *, '(a)' ) ' Observed Mean, Variance, Max, Min:' write ( *, '(a)' ) '' do i = 1, n write ( *, '(2x,i8,4g14.6)' ) i, mean(i), variance(i), xmax(i), xmin(i) end do return end subroutine dirichlet_pdf_test ( ) !*****************************************************************************80 ! !! DIRICHLET_PDF_test() tests DIRICHLET_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 13 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 3 real ( kind = rk ) a(n) logical dirichlet_check real ( kind = rk ) pdf real ( kind = rk ) x(n) write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_PDF_test():' write ( *, '(a)' ) ' DIRICHLET_PDF evaluates the Dirichlet PDF.' a(1:3) = (/ 0.250D+00, 0.500D+00, 1.250D+00 /) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Number of components N = ', n call r8vec_print ( n, a, ' PDF parameters A:' ) if ( .not. dirichlet_check ( n, a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_PDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if x(1:3) = (/ 0.500D+00, 0.125D+00, 0.375D+00 /) call r8vec_print ( n, x, ' PDF argument X: ' ) call dirichlet_pdf ( x, n, a, pdf ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF value = ', pdf return end subroutine dirichlet_mix_sample_test ( ) !*****************************************************************************80 ! !! DIRICHLET_MIX_SAMPLE_test() tests DIRICHLET_MIX_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 13 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: comp_num = 2 integer, parameter :: elem_num = 3 integer, parameter :: sample_num = 1000 real ( kind = rk ) a(elem_num,comp_num) integer comp real ( kind = rk ) comp_weight(comp_num) logical dirichlet_mix_check integer elem_i integer j real ( kind = rk ) mean(elem_num) real ( kind = rk ) variance(elem_num) real ( kind = rk ) x(elem_num,sample_num) real ( kind = rk ) xmax(elem_num) real ( kind = rk ) xmin(elem_num) write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_MIX_SAMPLE_test():' write ( *, '(a)' ) ' DIRICHLET_MIX_sample() samples the Dirichlet Mix distribution;' write ( *, '(a)' ) ' DIRICHLET_MIX_mean() computes the Dirichlet Mix mean;' a(1,1) = 0.250D+00 a(2,1) = 0.500D+00 a(3,1) = 1.250D+00 a(1,2) = 1.500D+00 a(2,2) = 0.500D+00 a(3,2) = 2.000D+00 comp_weight(1) = 1.0D+00 comp_weight(2) = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Number of elements ELEM_NUM = ', elem_num write ( *, '(a,i8)' ) ' Number of components COMP_NUM = ', comp_num call r8mat_print ( elem_num, comp_num, a, ' PDF parameters A(ELEM,COMP):' ) call r8vec_print ( comp_num, comp_weight, ' Component weights' ) if ( .not. dirichlet_mix_check ( comp_num, elem_num, a, comp_weight ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_MIX_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call dirichlet_mix_mean ( comp_num, elem_num, a, comp_weight, mean ) call r8vec_print ( elem_num, mean, ' PDF means: ' ) do j = 1, sample_num call dirichlet_mix_sample ( comp_num, elem_num, a, & comp_weight, comp, x(1,j) ) end do call r8row_max ( elem_num, sample_num, x, xmax ) call r8row_min ( elem_num, sample_num, x, xmin ) call r8row_mean ( elem_num, sample_num, x, mean ) call r8row_variance ( elem_num, sample_num, x, variance ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a)' ) '' write ( *, '(a)' ) ' Observed Mean, Variance, Max, Min:' write ( *, '(a)' ) '' do elem_i = 1, elem_num write ( *, '(2x,i8,4g14.6)' ) elem_i, & mean(elem_i), variance(elem_i), xmax(elem_i), xmin(elem_i) end do return end subroutine dirichlet_mix_pdf_test ( ) !*****************************************************************************80 ! !! DIRICHLET_MIX_PDF_test() tests DIRICHLET_MIX_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 13 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: comp_num = 2 integer, parameter :: elem_num = 3 real ( kind = rk ) a(elem_num,comp_num) real ( kind = rk ) comp_weight(comp_num) logical dirichlet_mix_check real ( kind = rk ) pdf real ( kind = rk ) x(elem_num) write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_MIX_PDF_test():' write ( *, '(a)' ) ' DIRICHLET_MIX_PDF evaluates the Dirichlet Mix PDF.' a(1,1) = 0.250D+00 a(2,1) = 0.500D+00 a(3,1) = 1.250D+00 a(1,2) = 1.500D+00 a(2,2) = 0.500D+00 a(3,2) = 2.000D+00 comp_weight(1:2) = (/ 1.0D+00, 2.0D+00 /) write ( *, '(a,i8)' ) ' Number of elements ELEM_NUM = ', elem_num write ( *, '(a,i8)' ) ' Number of components COMP_NUM = ', comp_num call r8mat_print ( elem_num, comp_num, a, ' PDF parameters A(ELEM,COMP):' ) call r8vec_print ( comp_num, comp_weight, ' Component weights' ) if ( .not. dirichlet_mix_check ( comp_num, elem_num, a, comp_weight ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DIRICHLET_MIX_PDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if x(1:3) = (/ 0.500D+00, 0.125D+00, 0.375D+00 /) call r8vec_print ( elem_num, x, ' PDF argument X: ' ) call dirichlet_mix_pdf ( x, comp_num, elem_num, a, comp_weight, & pdf ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF value = ', pdf return end subroutine discrete_cdf_test ( ) !*****************************************************************************80 ! !! DISCRETE_CDF_test() tests DISCRETE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: a = 6 real ( kind = rk ) b(a) real ( kind = rk ) cdf logical discrete_check integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'DISCRETE_CDF_test():' write ( *, '(a)' ) ' DISCRETE_CDF evaluates the Discrete CDF;' write ( *, '(a)' ) ' DISCRETE_CDF_INV inverts the Discrete CDF.' write ( *, '(a)' ) ' DISCRETE_PDF evaluates the Discrete PDF;' b(1:6) = (/ 1.0D+00, 2.0D+00, 6.0D+00, 2.0D+00, 4.0D+00, 1.0D+00 /) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a call r8vec_print ( a, b, ' PDF parameters B = ' ) if ( .not. discrete_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DISCRETE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call discrete_sample ( a, b, x ) call discrete_pdf ( x, a, b, pdf ) call discrete_cdf ( x, a, b, cdf ) call discrete_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine discrete_sample_test ( ) !*****************************************************************************80 ! !! DISCRETE_SAMPLE_test() tests DISCRETE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: a = 6 integer, parameter :: sample_num = 1000 real ( kind = rk ) b(a) logical discrete_check integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'DISCRETE_SAMPLE_test():' write ( *, '(a)' ) ' DISCRETE_mean() computes the Discrete mean;' write ( *, '(a)' ) ' DISCRETE_sample() samples the Discrete distribution;' write ( *, '(a)' ) ' DISCRETE_variance() computes the Discrete variance.' b(1:6) = (/ 1.0D+00, 2.0D+00, 6.0D+00, 2.0D+00, 4.0D+00, 1.0D+00 /) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a call r8vec_print ( a, b, ' PDF parameters B = ' ) if ( .not. discrete_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'DISCRETE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call discrete_mean ( a, b, mean ) call discrete_variance ( a, b, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call discrete_sample ( a, b, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine disk_sample_test ( ) !*****************************************************************************80 ! !! DISK_SAMPLE_test() tests DISK_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 18 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c integer i integer j real ( kind = rk ) mean(2) real ( kind = rk ) variance real ( kind = rk ) x_table(sample_num,2) real ( kind = rk ) x1 real ( kind = rk ) x2 real ( kind = rk ) xmax(2) real ( kind = rk ) xmin(2) write ( *, '(a)' ) '' write ( *, '(a)' ) 'DISK_SAMPLE_test():' write ( *, '(a)' ) ' DISK_MEAN returns the Disk mean.' write ( *, '(a)' ) ' DISK_sample() samples the Disk distribution.' write ( *, '(a)' ) ' DISK_VARIANCE returns the Disk variance.' a = 10.0D+00 b = 4.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' X coordinate of center is A = ', a write ( *, '(a,g14.6)' ) ' Y coordinate of center is B = ', b write ( *, '(a,g14.6)' ) ' Radius is C = ', c call disk_mean ( a, b, c, mean ) call disk_variance ( a, b, c, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6,2x,g14.6)' ) ' Disk mean = ', mean(1:2) write ( *, '(a,g14.6)' ) ' Disk variance = ', variance do i = 1, sample_num call disk_sample ( a, b, c, x1, x2 ) x_table(i,1) = x1 x_table(i,2) = x2 end do variance = sum ( ( x_table(1:sample_num,1) - a ) ** 2 & + ( x_table(1:sample_num,2) - b ) ** 2 ) & / real ( sample_num, kind = rk ) do j = 1, 2 call r8vec_mean ( sample_num, x_table(1,j), mean(j) ) call r8vec_max ( sample_num, x_table(1,j), xmax(j) ) call r8vec_min ( sample_num, x_table(1,j), xmin(j) ) end do write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,2g14.6)' ) ' Sample mean = ', mean(1:2) write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,2g14.6)' ) ' Sample maximum = ', xmax(1:2) write ( *, '(a,2g14.6)' ) ' Sample minimum = ', xmin(1:2) return end subroutine empirical_discrete_cdf_test ( ) !*****************************************************************************80 ! !! EMPIRICAL_DISCRETE_CDF_test() tests EMPIRICAL_DISCRETE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: a = 6 real ( kind = rk ), save, dimension ( a ) :: b = (/ & 1.0D+00, 1.0D+00, 3.0D+00, 2.0D+00, 1.0D+00, 2.0D+00 /) real ( kind = rk ), save, dimension ( a ) :: c = (/ & 0.0D+00, 1.0D+00, 2.0D+00, 4.5D+00, 6.0D+00, 10.0D+00 /) real ( kind = rk ) cdf logical empirical_discrete_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'EMPIRICAL_DISCRETE_CDF_test():' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_CDF evaluates the Empirical Discrete CDF;' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_CDF_INV inverts the Empirical Discrete CDF.' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_PDF evaluates the Empirical Discrete PDF;' write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a call r8vec_print ( a, b, ' PDF parameter B:' ) call r8vec_print ( a, c, ' PDF parameter C:' ) if ( .not. empirical_discrete_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'EMPIRICAL_DISCRETE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call empirical_discrete_sample ( a, b, c, x ) call empirical_discrete_pdf ( x, a, b, c, pdf ) call empirical_discrete_cdf ( x, a, b, c, cdf ) call empirical_discrete_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine empirical_discrete_sample_test ( ) !*****************************************************************************80 ! !! EMPIRICAL_DISCRETE_SAMPLE_test() tests EMPIRICAL_DISCRETE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: a = 6 integer, parameter :: sample_num = 1000 real ( kind = rk ), save, dimension ( a ) :: b = (/ & 1.0D+00, 1.0D+00, 3.0D+00, 2.0D+00, 1.0D+00, 2.0D+00 /) real ( kind = rk ), save, dimension ( a ) :: c = (/ & 0.0D+00, 1.0D+00, 2.0D+00, 4.5D+00, 6.0D+00, 10.0D+00 /) logical empirical_discrete_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'EMPIRICAL_DISCRETE_SAMPLE_test():' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_mean() computes the Empirical Discrete mean;' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_sample() samples the Empirical Discrete distribution;' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_variance() computes the Empirical Discrete variance.' write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a call r8vec_print ( a, b, ' PDF parameter B:' ) call r8vec_print ( a, c, ' PDF parameter C:' ) if ( .not. empirical_discrete_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'EMPIRICAL_DISCRETE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call empirical_discrete_mean ( a, b, c, mean ) call empirical_discrete_variance ( a, b, c, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call empirical_discrete_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine english_letter_cdf_test ( ) !*****************************************************************************80 ! !! ENGLISH_LETTER_CDF_test() tests ENGLISH_LETTER_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) character c character c2 real ( kind = rk ) cdf integer i real ( kind = rk ) pdf write ( *, '(a)' ) '' write ( *, '(a)' ) 'ENGLISH_LETTER_CDF_test():' write ( *, '(a)' ) ' ENGLISH_LETTER_CDF evaluates the English Letter CDF;' write ( *, '(a)' ) ' ENGLISH_LETTER_CDF_INV inverts the English Letter CDF.' write ( *, '(a)' ) ' ENGLISH_LETTER_PDF evaluates the English Letter PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' C PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call english_letter_sample ( c ) call english_letter_pdf ( c, pdf ) call english_letter_cdf ( c, cdf ) call english_letter_cdf_inv ( cdf, c2 ) write ( *, '(2x,a,2x,f14.6,2x,f14.6,2x,a)' ) & '"' // c // '"', pdf, cdf, '"' // c2 // '"' end do return end subroutine english_sentence_length_cdf_test ( ) !*****************************************************************************80 ! !! ENGLISH_SENTENCE_LENGTH_CDF_test() tests ENGLISH_SENTENCE_LENGTH_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'ENGLISH_SENTENCE_LENGTH_CDF_test():' write ( *, '(a)' ) ' ENGLISH_SENTENCE_LENGTH_CDF evaluates the English Sentence Length CDF;' write ( *, '(a)' ) ' ENGLISH_SENTENCE_LENGTH_CDF_INV inverts the English Sentence Length CDF.' write ( *, '(a)' ) ' ENGLISH_SENTENCE_LENGTH_PDF evaluates the English Sentence Length PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call english_sentence_length_sample ( x ) call english_sentence_length_pdf ( x, pdf ) call english_sentence_length_cdf ( x, cdf ) call english_sentence_length_cdf_inv ( cdf, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine english_sentence_length_sample_test ( ) !*****************************************************************************80 ! !! ENGLISH_SENTENCE_LENGTH_SAMPLE_test() tests ENGLISH_SENTENCE_LENGTH_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'ENGLISH_SENTENCE_LENGTH_SAMPLE_test():' write ( *, '(a)' ) ' ENGLISH_SENTENCE_LENGTH_mean() computes the English Sentence Length mean;' write ( *, '(a)' ) ' ENGLISH_SENTENCE_LENGTH_sample() samples the English Sentence Length distribution;' write ( *, '(a)' ) ' ENGLISH_SENTENCE_LENGTH_variance() computes the English Sentence Length variance.' call english_sentence_length_mean ( mean ) call english_sentence_length_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call english_sentence_length_sample ( x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine english_word_length_cdf_test ( ) !*****************************************************************************80 ! !! ENGLISH_WORD_LENGTH_CDF_test() tests ENGLISH_WORD_LENGTH_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'ENGLISH_WORD_LENGTH_CDF_test():' write ( *, '(a)' ) ' ENGLISH_WORD_LENGTH_CDF evaluates the English Word Length CDF;' write ( *, '(a)' ) ' ENGLISH_WORD_LENGTH_CDF_INV inverts the English Word Length CDF.' write ( *, '(a)' ) ' ENGLISH_WORD_LENGTH_PDF evaluates the English Word Length PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call english_word_length_sample ( x ) call english_word_length_pdf ( x, pdf ) call english_word_length_cdf ( x, cdf ) call english_word_length_cdf_inv ( cdf, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine english_word_length_sample_test ( ) !*****************************************************************************80 ! !! ENGLISH_WORD_LENGTH_SAMPLE_test() tests ENGLISH_WORD_LENGTH_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'ENGLISH_WORD_LENGTH_SAMPLE_test():' write ( *, '(a)' ) ' ENGLISH_WORD_LENGTH_mean() computes the English Word Length mean;' write ( *, '(a)' ) ' ENGLISH_WORD_LENGTH_sample() samples the English Word Length distribution;' write ( *, '(a)' ) ' ENGLISH_WORD_LENGTH_variance() computes the English Word Length variance.' call english_word_length_mean ( mean ) call english_word_length_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call english_word_length_sample ( x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine erlang_cdf_test ( ) !*****************************************************************************80 ! !! ERLANG_CDF_test() tests ERLANG_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b integer c real ( kind = rk ) cdf logical erlang_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'ERLANG_CDF_test():' write ( *, '(a)' ) ' ERLANG_CDF evaluates the Erlang CDF.' write ( *, '(a)' ) ' ERLANG_CDF_INV inverts the Erlang CDF.' write ( *, '(a)' ) ' ERLANG_PDF evaluates the Erlang PDF.' a = 1.0D+00 b = 2.0D+00 c = 3 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i8)' ) ' PDF parameter C = ', c if ( .not. erlang_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'ERLANG_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call erlang_sample ( a, b, c, x ) call erlang_pdf ( x, a, b, c, pdf ) call erlang_cdf ( x, a, b, c, cdf ) call erlang_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine erlang_sample_test ( ) !*****************************************************************************80 ! !! ERLANG_SAMPLE_test() tests ERLANG_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer c logical erlang_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'ERLANG_SAMPLE_test():' write ( *, '(a)' ) ' ERLANG_mean() computes the Erlang mean;' write ( *, '(a)' ) ' ERLANG_sample() samples the Erlang distribution;' write ( *, '(a)' ) ' ERLANG_variance() computes the Erlang variance.' a = 1.0D+00 b = 2.0D+00 c = 3 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i8)' ) ' PDF parameter C = ', c if ( .not. erlang_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'ERLANG_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call erlang_mean ( a, b, c, mean ) call erlang_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call erlang_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine exponential_01_cdf_test ( ) !*****************************************************************************80 ! !! EXPONENTIAL_01_CDF_test() tests EXPONENTIAL_01_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXPONENTIAL_01_CDF_test():' write ( *, '(a)' ) ' EXPONENTIAL_01_CDF evaluates the Exponential 01 CDF.' write ( *, '(a)' ) ' EXPONENTIAL_01_CDF_INV inverts the Exponential 01 CDF.' write ( *, '(a)' ) ' EXPONENTIAL_01_PDF evaluates the Exponential 01 PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call exponential_01_sample ( x ) call exponential_01_pdf ( x, pdf ) call exponential_01_cdf ( x, cdf ) call exponential_01_cdf_inv ( cdf, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine exponential_01_sample_test ( ) !*****************************************************************************80 ! !! EXPONENTIAL_01_SAMPLE_test() tests EXPONENTIAL_01_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXPONENTIAL_01_SAMPLE_test():' write ( *, '(a)' ) ' EXPONENTIAL_01_mean() computes the Exponential 01 mean;' write ( *, '(a)' ) ' EXPONENTIAL_01_sample() samples the Exponential 01 distribution;' write ( *, '(a)' ) ' EXPONENTIAL_01_variance() computes the Exponential 01 variance.' call exponential_01_mean ( mean ) call exponential_01_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call exponential_01_sample ( x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine exponential_cdf_test ( ) !*****************************************************************************80 ! !! EXPONENTIAL_CDF_test() tests EXPONENTIAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf logical exponential_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXPONENTIAL_CDF_test():' write ( *, '(a)' ) ' EXPONENTIAL_CDF evaluates the Exponential CDF.' write ( *, '(a)' ) ' EXPONENTIAL_CDF_INV inverts the Exponential CDF.' write ( *, '(a)' ) ' EXPONENTIAL_PDF evaluates the Exponential PDF.' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. exponential_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXPONENTIAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call exponential_sample ( a, b, x ) call exponential_pdf ( x, a, b, pdf ) call exponential_cdf ( x, a, b, cdf ) call exponential_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine exponential_sample_test ( ) !*****************************************************************************80 ! !! EXPONENTIAL_SAMPLE_test() tests EXPONENTIAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical exponential_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXPONENTIAL_SAMPLE_test():' write ( *, '(a)' ) ' EXPONENTIAL_mean() computes the Exponential mean;' write ( *, '(a)' ) ' EXPONENTIAL_sample() samples the Exponential distribution;' write ( *, '(a)' ) ' EXPONENTIAL_variance() computes the Exponential variance.' a = 1.0D+00 b = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. exponential_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXPONENTIAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call exponential_mean ( a, b, mean ) call exponential_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call exponential_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine extreme_values_cdf_test ( ) !*****************************************************************************80 ! !! EXTREME_VALUES_CDF_test() tests EXTREME_VALUES_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf logical extreme_values_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXTREME_VALUES_CDF_test():' write ( *, '(a)' ) ' EXTREME_VALUES_CDF evaluates the Extreme Values CDF;' write ( *, '(a)' ) ' EXTREME_VALUES_CDF_INV inverts the Extreme Values CDF.' write ( *, '(a)' ) ' EXTREME_VALUES_PDF evaluates the Extreme Values PDF;' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. extreme_values_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXTREME_VALUES_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call extreme_values_sample ( a, b, x ) call extreme_values_pdf ( x, a, b, pdf ) call extreme_values_cdf ( x, a, b, cdf ) call extreme_values_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine extreme_values_sample_test ( ) !*****************************************************************************80 ! !! EXTREME_VALUES_SAMPLE_test() tests EXTREME_VALUES_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical extreme_values_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXTREME_VALUES_SAMPLE_test():' write ( *, '(a)' ) ' EXTREME_VALUES_mean() computes the Extreme Values mean;' write ( *, '(a)' ) ' EXTREME_VALUES_sample() samples the Extreme Values distribution;' write ( *, '(a)' ) ' EXTREME_VALUES_variance() computes the Extreme Values variance.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. extreme_values_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'EXTREME_VALUES_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call extreme_values_mean ( a, b, mean ) call extreme_values_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call extreme_values_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine f_cdf_test ( ) !*****************************************************************************80 ! !! F_CDF_test() tests F_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf logical f_check integer i integer m integer n real ( kind = rk ) pdf real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'F_CDF_test():' write ( *, '(a)' ) ' F_CDF evaluates the F CDF.' write ( *, '(a)' ) ' F_PDF evaluates the F PDF.' write ( *, '(a)' ) ' F_sample() samples the F PDF.' m = 1 n = 1 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter M = ', m write ( *, '(a,i8)' ) ' PDF parameter N = ', n if ( .not. f_check ( m, n ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'F_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF' write ( *, '(a)' ) '' do i = 1, 10 call f_sample ( m, n, x ) call f_pdf ( x, m, n, pdf ) call f_cdf ( x, m, n, cdf ) write ( *, '(2x,g14.6,2x,g14.6,2x,g14.6)' ) x, pdf, cdf end do return end subroutine f_sample_test ( ) !*****************************************************************************80 ! !! F_SAMPLE_test() tests F_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 logical f_check integer i integer m real ( kind = rk ) mean integer n real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'F_SAMPLE_test():' write ( *, '(a)' ) ' F_mean() computes the F mean;' write ( *, '(a)' ) ' F_sample() samples the F distribution;' write ( *, '(a)' ) ' F_variance() computes the F variance.' m = 8 n = 6 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter M = ', m write ( *, '(a,i8)' ) ' PDF parameter N = ', n if ( .not. f_check ( m, n ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'F_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call f_mean ( m, n, mean ) call f_variance ( m, n, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call f_sample ( m, n, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine fermi_dirac_sample_test ( ) !*****************************************************************************80 ! !! FERMI_DIRAC_SAMPLE_test() tests FERMI_DIRAC_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 January 2008 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 10000 integer, parameter :: test_num = 7 integer i real ( kind = rk ) mean integer test real ( kind = rk ) u real ( kind = rk ), dimension ( test_num ) :: u_test = (/ & 1.0D+00, 2.0D+00, 4.0D+00, 8.0D+00, 16.0D+00, & 32.0D+00, 1.0D+00 /) real ( kind = rk ) v real ( kind = rk ), dimension ( test_num ) :: v_test = (/ & 1.0D+00, 1.0D+00, 1.0D+00, 1.0D+00, 1.0D+00, & 1.0D+00, 0.25D+00 /) real ( kind = rk ) variance real ( kind = rk ) z(sample_num) real ( kind = rk ) z_max real ( kind = rk ) z_min write ( *, '(a)' ) '' write ( *, '(a)' ) 'FERMI_DIRAC_SAMPLE_test():' write ( *, '(a)' ) ' FERMI_DIRAC_sample() samples the Fermi Dirac distribution.' do test = 1, test_num u = u_test(test) v = v_test(test) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' U = ', u write ( *, '(a,g14.6)' ) ' V = ', v do i = 1, sample_num call fermi_dirac_sample ( u, v, z(i) ) end do z_max = maxval ( z(1:sample_num) ) z_min = minval ( z(1:sample_num) ) call r8vec_mean ( sample_num, z, mean ) call r8vec_variance ( sample_num, z, variance ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' SAMPLE_NUM = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Maximum value = ', z_max write ( *, '(a,g14.6)' ) ' Minimum value = ', z_min end do return end subroutine fisher_pdf_test ( ) !*****************************************************************************80 ! !! FISHER_PDF_test() tests FISHER_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 10 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 10 integer, parameter :: test_num = 3 integer j real ( kind = rk ) kappa real ( kind = rk ) mu(3) real ( kind = rk ) pdf integer test real ( kind = rk ) x(3) write ( *, '(a)' ) '' write ( *, '(a)' ) 'FISHER_PDF_test():' write ( *, '(a)' ) ' FISHER_PDF evaluates the Fisher PDF.' do test = 1, test_num if ( test == 1 ) then kappa = 0.0D+00 mu = (/ 1.0D+00, 0.0D+00, 0.0D+00 /) else if ( test == 2 ) then kappa = 0.5D+00 mu = (/ 1.0D+00, 0.0D+00, 0.0D+00 /) else if ( test == 3 ) then kappa = 10.0D+00 mu = (/ 1.0D+00, 0.0D+00, 0.0D+00 /) end if write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameters:' write ( *, '(a,g14.6)' ) ' Concentration parameter KAPPA = ', kappa write ( *, '(a,3f8.4)' ) ' Direction MU(1:3) = ', mu(1:3) write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF' write ( *, '(a)' ) '' do j = 1, n call fisher_sample ( kappa, mu, 1, x ) call fisher_pdf ( x, kappa, mu, pdf ) write ( *, '(2x,3f8.4,2x,g14.6)' ) x(1:3), pdf end do end do return end subroutine fisk_cdf_test ( ) !*****************************************************************************80 ! !! FISK_CDF_test() tests FISK_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf logical fisk_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'FISK_CDF_test():' write ( *, '(a)' ) ' FISK_CDF evaluates the Fisk CDF;' write ( *, '(a)' ) ' FISK_CDF_INV inverts the Fisk CDF.' write ( *, '(a)' ) ' FISK_PDF evaluates the Fisk PDF;' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. fisk_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'FISK_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call fisk_sample ( a, b, c, x ) call fisk_pdf ( x, a, b, c, pdf ) call fisk_cdf ( x, a, b, c, cdf ) call fisk_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine fisk_sample_test ( ) !*****************************************************************************80 ! !! FISK_SAMPLE_test() tests FISK_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c logical fisk_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'FISK_SAMPLE_test():' write ( *, '(a)' ) ' FISK_mean() computes the Fisk mean;' write ( *, '(a)' ) ' FISK_sample() samples the Fisk distribution;' write ( *, '(a)' ) ' FISK_variance() computes the Fisk variance.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. fisk_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'FISK_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call fisk_mean ( a, b, c, mean ) call fisk_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call fisk_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine folded_normal_cdf_test ( ) !*****************************************************************************80 ! !! FOLDED_NORMAL_CDF_test() tests FOLDED_NORMAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf logical folded_normal_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'FOLDED_NORMAL_CDF_test():' write ( *, '(a)' ) ' FOLDED_NORMAL_CDF evaluates the Folded Normal CDF.' write ( *, '(a)' ) ' FOLDED_NORMAL_CDF_INV inverts the Folded Normal CDF.' write ( *, '(a)' ) ' FOLDED_NORMAL_PDF evaluates the Folded Normal PDF.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. folded_normal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'FOLDED_NORMAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call folded_normal_sample ( a, b, x ) call folded_normal_pdf ( x, a, b, pdf ) call folded_normal_cdf ( x, a, b, cdf ) call folded_normal_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine folded_normal_sample_test ( ) !*****************************************************************************80 ! !! FOLDED_NORMAL_SAMPLE_test() tests FOLDED_NORMAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical folded_normal_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'FOLDED_NORMAL_SAMPLE_test():' write ( *, '(a)' ) ' FOLDED_NORMAL_mean() computes the Folded Normal mean;' write ( *, '(a)' ) ' FOLDED_NORMAL_sample() samples the Folded Normal distribution;' write ( *, '(a)' ) ' FOLDED_NORMAL_variance() computes the Folded Normal variance.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. folded_normal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call folded_normal_mean ( a, b, mean ) call folded_normal_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call folded_normal_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine frechet_cdf_test ( ) !*****************************************************************************80 ! !! FRECHET_CDF_test() tests FRECHET_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) alpha real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'FRECHET_CDF_test():' write ( *, '(a)' ) ' FRECHET_CDF evaluates the Frechet CDF;' write ( *, '(a)' ) ' FRECHET_CDF_INV inverts the Frechet CDF.' write ( *, '(a)' ) ' FRECHET_PDF evaluates the Frechet PDF;' alpha = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter ALPHA = ', alpha write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call frechet_sample ( alpha, x ) call frechet_pdf ( x, alpha, pdf ) call frechet_cdf ( x, alpha, cdf ) call frechet_cdf_inv ( cdf, alpha, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine frechet_sample_test ( ) !*****************************************************************************80 ! !! FRECHET_SAMPLE_test() tests FRECHET_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) alpha integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'FRECHET_SAMPLE_test():' write ( *, '(a)' ) ' FRECHET_mean() computes the Frechet mean;' write ( *, '(a)' ) ' FRECHET_sample() samples the Frechet distribution;' write ( *, '(a)' ) ' FRECHET_variance() computes the Frechet variance.' alpha = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter ALPHA = ', alpha call frechet_mean ( alpha, mean ) call frechet_variance ( alpha, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call frechet_sample ( alpha, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine gamma_cdf_test ( ) !*****************************************************************************80 ! !! GAMMA_CDF_test() tests GAMMA_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf logical gamma_check integer i real ( kind = rk ) pdf real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'GAMMA_CDF_test():' write ( *, '(a)' ) ' GAMMA_CDF evaluates the Gamma CDF.' write ( *, '(a)' ) ' GAMMA_PDF evaluates the Gamma PDF.' a = 1.0D+00 b = 1.5D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. gamma_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GAMMA_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF' write ( *, '(a)' ) '' do i = 1, 10 call gamma_sample ( a, b, c, x ) call gamma_cdf ( x, a, b, c, cdf ) call gamma_pdf ( x, a, b, c, pdf ) write ( *, '(2x,3g14.6)' ) x, pdf, cdf end do return end subroutine gamma_sample_test ( ) !*****************************************************************************80 ! !! GAMMA_SAMPLE_test() tests GAMMA_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 25 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c logical gamma_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'GAMMA_SAMPLE_test():' write ( *, '(a)' ) ' GAMMA_mean() computes the Gamma mean;' write ( *, '(a)' ) ' GAMMA_sample() samples the Gamma distribution;' write ( *, '(a)' ) ' GAMMA_variance() computes the Gamma variance.' a = 1.0D+00 b = 3.0D+00 c = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. gamma_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GAMMA_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call gamma_mean ( a, b, c, mean ) call gamma_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call gamma_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine genlogistic_cdf_test ( ) !*****************************************************************************80 ! !! GENLOGISTIC_CDF_test() tests GENLOGISTIC_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf logical genlogistic_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'GENLOGISTIC_CDF_test():' write ( *, '(a)' ) ' GENLOGISTIC_PDF evaluates the Genlogistic PDF.' write ( *, '(a)' ) ' GENLOGISTIC_CDF evaluates the Genlogistic CDF;' write ( *, '(a)' ) ' GENLOGISTIC_CDF_INV inverts the Genlogistic CDF.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. genlogistic_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GENLOGISTIC_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call genlogistic_sample ( a, b, c, x ) call genlogistic_pdf ( x, a, b, c, pdf ) call genlogistic_cdf ( x, a, b, c, cdf ) call genlogistic_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine genlogistic_sample_test ( ) !*****************************************************************************80 ! !! GENLOGISTIC_SAMPLE_test() tests GENLOGISTIC_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c logical genlogistic_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'GENLOGISTIC_SAMPLE_test():' write ( *, '(a)' ) ' GENLOGISTIC_mean() computes the Genlogistic mean;' write ( *, '(a)' ) ' GENLOGISTIC_sample() samples the Genlogistic distribution;' write ( *, '(a)' ) ' GENLOGISTIC_variance() computes the Genlogistic variance.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. genlogistic_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GENLOGISTIC_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call genlogistic_mean ( a, b, c, mean ) call genlogistic_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call genlogistic_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine geometric_cdf_test ( ) !*****************************************************************************80 ! !! GEOMETRIC_CDF_test() tests GEOMETRIC_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf logical geometric_check integer i real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'GEOMETRIC_CDF_test():' write ( *, '(a)' ) ' GEOMETRIC_CDF evaluates the Geometric CDF;' write ( *, '(a)' ) ' GEOMETRIC_CDF_INV inverts the Geometric CDF.' write ( *, '(a)' ) ' GEOMETRIC_PDF evaluates the Geometric PDF;' a = 0.25D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. geometric_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GEOMETRIC_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call geometric_sample ( a, x ) call geometric_pdf ( x, a, pdf ) call geometric_cdf ( x, a, cdf ) call geometric_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine geometric_sample_test ( ) !*****************************************************************************80 ! !! GEOMETRIC_SAMPLE_test() tests GEOMETRIC_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a logical geometric_check integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'GEOMETRIC_SAMPLE_test():' write ( *, '(a)' ) ' GEOMETRIC_mean() computes the Geometric mean;' write ( *, '(a)' ) ' GEOMETRIC_sample() samples the Geometric distribution;' write ( *, '(a)' ) ' GEOMETRIC_variance() computes the Geometric variance.' a = 0.25D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. geometric_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GEOMETRIC_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call geometric_mean ( a, mean ) call geometric_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call geometric_sample ( a, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine gompertz_cdf_test ( ) !*****************************************************************************80 ! !! GOMPERTZ_CDF_test() tests GOMPERTZ_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf logical gompertz_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'GOMPERTZ_CDF_test():' write ( *, '(a)' ) ' GOMPERTZ_CDF evaluates the Gompertz CDF;' write ( *, '(a)' ) ' GOMPERTZ_CDF_INV inverts the Gompertz CDF.' write ( *, '(a)' ) ' GOMPERTZ_PDF evaluates the Gompertz PDF;' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. gompertz_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'GOMPERTZ_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call gompertz_sample ( a, b, x ) call gompertz_pdf ( x, a, b, pdf ) call gompertz_cdf ( x, a, b, cdf ) call gompertz_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine gompertz_sample_test ( ) !*****************************************************************************80 ! !! GOMPERTZ_SAMPLE_test() tests GOMPERTZ_SAMPLE; ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical gompertz_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'GOMPERTZ_SAMPLE_test():' write ( *, '(a)' ) ' GOMPERTZ_sample() samples the Gompertz distribution;' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. gompertz_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if do i = 1, sample_num call gompertz_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine gumbel_cdf_test ( ) !*****************************************************************************80 ! !! GUMBEL_CDF_test() tests GUMBEL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'GUMBEL_CDF_test():' write ( *, '(a)' ) ' GUMBEL_CDF evaluates the Gumbel CDF.' write ( *, '(a)' ) ' GUMBEL_CDF_INV inverts the Gumbel CDF.' write ( *, '(a)' ) ' GUMBEL_PDF evaluates the Gumbel PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call gumbel_sample ( x ) call gumbel_pdf ( x, pdf ) call gumbel_cdf ( x, cdf ) call gumbel_cdf_inv ( cdf, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine gumbel_sample_test ( ) !*****************************************************************************80 ! !! GUMBEL_SAMPLE_test() tests GUMBEL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'GUMBEL_SAMPLE_test():' write ( *, '(a)' ) ' GUMBEL_mean() computes the Gumbel mean;' write ( *, '(a)' ) ' GUMBEL_sample() samples the Gumbel distribution;' write ( *, '(a)' ) ' GUMBEL_variance() computes the Gumbel variance.' call gumbel_mean ( mean ) call gumbel_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call gumbel_sample ( x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine half_normal_cdf_test ( ) !*****************************************************************************80 ! !! HALF_NORMAL_CDF_test() tests HALF_NORMAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf logical half_normal_check integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'HALF_NORMAL_CDF_test():' write ( *, '(a)' ) ' HALF_NORMAL_CDF evaluates the Half Normal CDF.' write ( *, '(a)' ) ' HALF_NORMAL_CDF_INV inverts the Half Normal CDF.' write ( *, '(a)' ) ' HALF_NORMAL_PDF evaluates the Half Normal PDF.' a = 0.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. half_normal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'HALF_NORMAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call half_normal_sample ( a, b, x ) call half_normal_pdf ( x, a, b, pdf ) call half_normal_cdf ( x, a, b, cdf ) call half_normal_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine half_normal_sample_test ( ) !*****************************************************************************80 ! !! HALF_NORMAL_SAMPLE_test() tests HALF_NORMAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b logical half_normal_check integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'HALF_NORMAL_SAMPLE_test():' write ( *, '(a)' ) ' HALF_NORMAL_mean() computes the Half Normal mean;' write ( *, '(a)' ) ' HALF_NORMAL_sample() samples the Half Normal distribution;' write ( *, '(a)' ) ' HALF_NORMAL_variance() computes the Half Normal variance.' a = 0.0D+00 b = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. half_normal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'HALF_NORMAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call half_normal_mean ( a, b, mean ) call half_normal_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call half_normal_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine hypergeometric_cdf_test ( ) !*****************************************************************************80 ! !! HYPERGEOMETRIC_CDF_test() tests HYPERGEOMETRIC_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf logical hypergeometric_check integer l integer m integer n real ( kind = rk ) pdf integer x write ( *, '(a)' ) '' write ( *, '(a)' ) 'HYPERGEOMETRIC_CDF_test():' write ( *, '(a)' ) ' HYPERGEOMETRIC_CDF evaluates the Hypergeometric CDF.' write ( *, '(a)' ) ' HYPERGEOMETRIC_PDF evaluates the Hypergeometric PDF.' x = 7 n = 10 m = 7 l = 100 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Total number of balls = ', l write ( *, '(a,i8)' ) ' Number of white balls = ', m write ( *, '(a,i8)' ) ' Number of balls taken = ', n if ( .not. hypergeometric_check ( n, m, l ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'HYPERGEOMETRIC_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call hypergeometric_pdf ( x, n, m, l, pdf ) call hypergeometric_cdf ( x, n, m, l, cdf ) write ( *, '(a,i8)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value = = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = = ', cdf return end subroutine hypergeometric_sample_test ( ) !*****************************************************************************80 ! !! HYPERGEOMETRIC_SAMPLE_test() tests HYPERGEOMETRIC_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 logical hypergeometric_check integer i integer l integer m real ( kind = rk ) mean integer n real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'HYPERGEOMETRIC_SAMPLE_test():' write ( *, '(a)' ) ' HYPERGEOMETRIC_mean() computes the Hypergeometric mean;' write ( *, '(a)' ) ' HYPERGEOMETRIC_sample() samples the Hypergeometric distribution;' write ( *, '(a)' ) ' HYPERGEOMETRIC_variance() computes the Hypergeometric variance.' n = 10 m = 7 l = 100 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter N = ', n write ( *, '(a,i8)' ) ' PDF parameter M = ', m write ( *, '(a,i8)' ) ' PDF parameter L = ', l if ( .not. hypergeometric_check ( n, m, l ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'HYPERGEOMETRIC_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call hypergeometric_mean ( n, m, l, mean ) call hypergeometric_variance ( n, m, l, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call hypergeometric_sample ( n, m, l, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine i4_choose_test ( ) !*****************************************************************************80 ! !! I4_CHOOSE_test() tests I4_CHOOSE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 October 2014 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer cnk integer i4_choose integer k integer n write ( *, '(a)' ) '' write ( *, '(a)' ) 'I4_CHOOSE_test():' write ( *, '(a)' ) ' I4_CHOOSE evaluates C(N,K).' write ( *, '(a)' ) '' write ( *, '(a)' ) ' N K CNK' do n = 0, 4 write ( *, '(a)' ) '' do k = 0, n cnk = i4_choose ( n, k ) write ( *, '(2x,i8,2x,i8,2x,i8)' ) n, k, cnk end do end do return end subroutine i4_choose_log_test ( ) !*****************************************************************************80 ! !! I4_CHOOSE_LOG_test() tests I4_CHOOSE_LOG. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 05 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer cnk real ( kind = rk ) elcnk integer i4_choose real ( kind = rk ) i4_choose_log integer k real ( kind = rk ) lcnk integer n write ( *, '(a)' ) '' write ( *, '(a)' ) 'I4_CHOOSE_LOG_test():' write ( *, '(a)' ) ' I4_CHOOSE_LOG evaluates log(C(N,K)).' write ( *, '(a)' ) '' write ( *, '(a)' ) ' N K lcnk elcnk CNK' do n = 0, 4 write ( *, '(a)' ) '' do k = 0, n lcnk = i4_choose_log ( n, k ) elcnk = exp ( lcnk ) cnk = i4_choose ( n, k ) write ( *, '(2x,i8,2x,i8,2x,g14.6,2x,g14.6,2x,i8)' ) n, k, lcnk, elcnk, cnk end do end do return end subroutine i4_is_power_of_10_test ( ) !*****************************************************************************80 ! !! I4_IS_POWER_OF_10_test() tests I4_IS_POWER_OF_10. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer i logical ( kind = 4 ) i4_is_power_of_10 write ( *, '(a)' ) '' write ( *, '(a)' ) 'I4_IS_POWER_OF_10_test():' write ( *, '(a)' ) ' I4_IS_POWER_OF_10 reports whether an I4 is a power of 10.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' I I4_IS_POWER_OF_10(I)' write ( *, '(a)' ) '' do i = 97, 103 write ( *, '(2x,i6,2x,l1)' ) i, i4_is_power_of_10 ( i ) end do return end subroutine i4_uniform_ab_test ( ) !*****************************************************************************80 ! !! I4_UNIFORM_AB_test() tests I4_UNIFORM_AB. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 October 2014 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: a = -100 integer, parameter :: b = 200 integer i integer i4_uniform_ab integer j write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'I4_UNIFORM_AB_test():' write ( *, '(a)' ) ' I4_UNIFORM_AB computes pseudorandom values ' write ( *, '(a)' ) ' in an interval [A,B].' write ( *, '(a)' ) ' ' write ( *, '(a,i12)' ) ' The lower endpoint A = ', a write ( *, '(a,i12)' ) ' The upper endpoint B = ', b write ( *, '(a)' ) ' ' do i = 1, 20 j = i4_uniform_ab ( a, b ) write ( *, '(2x,i8,2x,i8)' ) i, j end do return end subroutine i4vec_uniform_ab_test ( ) !*****************************************************************************80 ! !! I4VEC_UNIFORM_AB_test() tests I4VEC_UNIFORM_AB. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 October 2014 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 20 integer, parameter :: a = -100 integer, parameter :: b = 200 integer v(n) write ( *, '(a)' ) '' write ( *, '(a)' ) 'I4VEC_UNIFORM_AB_test():' write ( *, '(a)' ) ' I4VEC_UNIFORM_AB computes pseudorandom values ' write ( *, '(a)' ) ' in an interval [A,B].' write ( *, '(a)' ) '' write ( *, '(a,i12)' ) ' The lower endpoint A = ', a write ( *, '(a,i12)' ) ' The upper endpoint B = ', b call i4vec_uniform_ab ( n, a, b, v ) call i4vec_print ( n, v, ' The random vector:' ) return end subroutine i4vec_unique_count_test ( ) !*****************************************************************************80 ! !! I4VEC_UNIQUE_COUNT_test() tests I4VEC_UNIQUE_COUNT. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 20 integer a(n) integer a_unique integer b integer c b = 0 c = n write ( *, '(a)' ) '' write ( *, '(a)' ) 'I4VEC_UNIQUE_COUNT_test():' write ( *, '(a)' ) ' I4VEC_UNIQUE_COUNT counts unique entries in an I4VEC.' call i4vec_uniform_ab ( n, b, c, a ) call i4vec_print ( n, a, ' Input vector:' ) call i4vec_unique_count ( n, a, a_unique ) write ( *, '(a)' ) '' write ( *, '(a,i4)' ) ' Number of unique entries is ', a_unique return end subroutine inverse_gaussian_cdf_test ( ) !*****************************************************************************80 ! !! INVERSE_GAUSSIAN_CDF_test() tests INVERSE_GAUSSIAN_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical inverse_gaussian_check real ( kind = rk ) pdf real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'INVERSE_GAUSSIAN_CDF_test():' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_CDF evaluates the Inverse Gaussian CDF.' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_PDF evaluates the Inverse Gaussian PDF.' a = 5.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. inverse_gaussian_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'INVERSE_GAUSSIAN_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF' write ( *, '(a)' ) '' do i = 1, 10 call inverse_gaussian_sample ( a, b, x ) call inverse_gaussian_pdf ( x, a, b, pdf ) call inverse_gaussian_cdf ( x, a, b, cdf ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf end do return end subroutine inverse_gaussian_sample_test ( ) !*****************************************************************************80 ! !! INVERSE_GAUSSIAN_SAMPLE_test() tests INVERSE_GAUSSIAN_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i logical inverse_gaussian_check real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'INVERSE_GAUSSIAN_SAMPLE_test():' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_mean() computes the Inverse Gaussian mean;' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_sample() samples the Inverse Gaussian distribution;' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_variance() computes the Inverse Gaussian variance.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. inverse_gaussian_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'INVERSE_GAUSSIAN_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call inverse_gaussian_mean ( a, b, mean ) call inverse_gaussian_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call inverse_gaussian_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine laplace_cdf_test ( ) !*****************************************************************************80 ! !! LAPLACE_CDF_test() tests LAPLACE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical laplace_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LAPLACE_CDF_test():' write ( *, '(a)' ) ' LAPLACE_CDF evaluates the Laplace CDF;' write ( *, '(a)' ) ' LAPLACE_CDF_INV inverts the Laplace CDF.' write ( *, '(a)' ) ' LAPLACE_PDF evaluates the Laplace PDF;' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. laplace_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LAPLACE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call laplace_sample ( a, b, x ) call laplace_pdf ( x, a, b, pdf ) call laplace_cdf ( x, a, b, cdf ) call laplace_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine laplace_sample_test ( ) !*****************************************************************************80 ! !! LAPLACE_SAMPLE_test() tests LAPLACE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i logical laplace_check real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'LAPLACE_SAMPLE_test():' write ( *, '(a)' ) ' LAPLACE_mean() computes the Laplace mean;' write ( *, '(a)' ) ' LAPLACE_sample() samples the Laplace distribution;' write ( *, '(a)' ) ' LAPLACE_variance() computes the Laplace variance.' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. laplace_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LAPLACE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call laplace_mean ( a, b, mean ) call laplace_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call laplace_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine levy_cdf_test ( ) !*****************************************************************************80 ! !! LEVY_CDF_test() tests LEVY_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf real ( kind = rk ) pdf integer test integer, parameter :: test_num = 10 real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LEVY_CDF_test():' write ( *, '(a)' ) ' LEVY_CDF evaluates the Levy CDF;' write ( *, '(a)' ) ' LEVY_CDF_INV inverts the Levy CDF.' write ( *, '(a)' ) ' LEVY_PDF evaluates the Levy PDF;' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF X2' write ( *, '(a)' ) '' do test = 1, test_num call levy_sample ( a, b, x ) call levy_pdf ( x, a, b, pdf ) call levy_cdf ( x, a, b, cdf ) call levy_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,g12.6,2x,g12.6,2x,g12.6,2x,g12.6)' ) x, pdf, cdf, x2 end do return end subroutine logistic_cdf_test ( ) !*****************************************************************************80 ! !! LOGISTIC_CDF_test() tests LOGISTIC_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical logistic_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOGISTIC_CDF_test():' write ( *, '(a)' ) ' LOGISTIC_CDF evaluates the Logistic CDF;' write ( *, '(a)' ) ' LOGISTIC_CDF_INV inverts the Logistic CDF.' write ( *, '(a)' ) ' LOGISTIC_PDF evaluates the Logistic PDF;' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. logistic_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOGISTIC_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call logistic_sample ( a, b, x ) call logistic_pdf ( x, a, b, pdf ) call logistic_cdf ( x, a, b, cdf ) call logistic_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine logistic_sample_test ( ) !*****************************************************************************80 ! !! LOGISTIC_SAMPLE_test() tests LOGISTIC_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i logical logistic_check real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOGISTIC_SAMPLE_test():' write ( *, '(a)' ) ' LOGISTIC_mean() computes the Logistic mean;' write ( *, '(a)' ) ' LOGISTIC_sample() samples the Logistic distribution;' write ( *, '(a)' ) ' LOGISTIC_variance() computes the Logistic variance.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. logistic_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOGISTIC_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call logistic_mean ( a, b, mean ) call logistic_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call logistic_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine log_normal_cdf_test ( ) !*****************************************************************************80 ! !! LOG_NORMAL_CDF_test() tests LOG_NORMAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical log_normal_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_NORMAL_CDF_test():' write ( *, '(a)' ) ' LOG_NORMAL_CDF evaluates the Log Normal CDF;' write ( *, '(a)' ) ' LOG_NORMAL_CDF_INV inverts the Log Normal CDF.' write ( *, '(a)' ) ' LOG_NORMAL_PDF evaluates the Log Normal PDF;' a = 10.0D+00 b = 2.25D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. log_normal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_NORMAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call log_normal_sample ( a, b, x ) call log_normal_pdf ( x, a, b, pdf ) call log_normal_cdf ( x, a, b, cdf ) call log_normal_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine log_normal_sample_test ( ) !*****************************************************************************80 ! !! LOG_NORMAL_SAMPLE_test() tests LOG_NORMAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i logical log_normal_check real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_NORMAL_SAMPLE_test():' write ( *, '(a)' ) ' LOG_NORMAL_mean() computes the Log Normal mean;' write ( *, '(a)' ) ' LOG_NORMAL_sample() samples the Log Normal distribution;' write ( *, '(a)' ) ' LOG_NORMAL_variance() computes the Log Normal variance.' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. log_normal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_NORMAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call log_normal_mean ( a, b, mean ) call log_normal_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call log_normal_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine log_series_cdf_test ( ) !*****************************************************************************80 ! !! LOG_SERIES_CDF_test() tests LOG_SERIES_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf integer i logical log_series_check real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_SERIES_CDF_test():' write ( *, '(a)' ) ' LOG_SERIES_CDF evaluates the Log Series CDF;' write ( *, '(a)' ) ' LOG_SERIES_CDF_INV inverts the Log Series CDF.' write ( *, '(a)' ) ' LOG_SERIES_PDF evaluates the Log Series PDF;' a = 0.25D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. log_series_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_SERIES_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call log_series_sample ( a, x ) call log_series_pdf ( x, a, pdf ) call log_series_cdf ( x, a, cdf ) call log_series_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine log_series_sample_test ( ) !*****************************************************************************80 ! !! LOG_SERIES_SAMPLE_test() tests LOG_SERIES_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a integer i logical log_series_check real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_SERIES_SAMPLE_test():' write ( *, '(a)' ) ' LOG_SERIES_mean() computes the Log Series mean;' write ( *, '(a)' ) ' LOG_SERIES_variance() computes the Log Series variance;' write ( *, '(a)' ) ' LOG_SERIES_sample() samples the Log Series distribution.' a = 0.25D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. log_series_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_SERIES_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call log_series_mean ( a, mean ) call log_series_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call log_series_sample ( a, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine log_uniform_cdf_test ( ) !*****************************************************************************80 ! !! LOG_UNIFORM_CDF_test() tests LOG_UNIFORM_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical log_uniform_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_UNIFORM_CDF_test():' write ( *, '(a)' ) ' LOG_UNIFORM_CDF evaluates the Log Uniform CDF;' write ( *, '(a)' ) ' LOG_UNIFORM_CDF_INV inverts the Log Uniform CDF.' write ( *, '(a)' ) ' LOG_UNIFORM_PDF evaluates the Log Uniform PDF;' a = 2.0D+00 b = 20.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. log_uniform_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_UNIFORM_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call log_uniform_sample ( a, b, x ) call log_uniform_pdf ( x, a, b, pdf ) call log_uniform_cdf ( x, a, b, cdf ) call log_uniform_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine log_uniform_sample_test ( ) !*****************************************************************************80 ! !! LOG_UNIFORM_SAMPLE_test() tests LOG_UNIFORM_SAMPLE; ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i logical log_uniform_check real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_UNIFORM_SAMPLE_test():' write ( *, '(a)' ) ' LOG_UNIFORM_mean() computes the Log Uniform mean;' write ( *, '(a)' ) ' LOG_UNIFORM_sample() samples the Log Uniform distribution;' a = 2.0D+00 b = 20.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. log_uniform_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'LOG_UNIFORM_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call log_uniform_mean ( a, b, mean ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean do i = 1, sample_num call log_uniform_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine lorentz_cdf_test ( ) !*****************************************************************************80 ! !! LORENTZ_CDF_test() tests LORENTZ_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'LORENTZ_CDF_test():' write ( *, '(a)' ) ' LORENTZ_CDF evaluates the Lorentz CDF;' write ( *, '(a)' ) ' LORENTZ_CDF_INV inverts the Lorentz CDF.' write ( *, '(a)' ) ' LORENTZ_PDF evaluates the Lorentz PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call lorentz_sample ( x ) call lorentz_pdf ( x, pdf ) call lorentz_cdf ( x, cdf ) call lorentz_cdf_inv ( cdf, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine lorentz_sample_test ( ) !*****************************************************************************80 ! !! LORENTZ_SAMPLE_test() tests LORENTZ_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'LORENTZ_SAMPLE_test():' write ( *, '(a)' ) ' LORENTZ_mean() computes the Lorentz mean;' write ( *, '(a)' ) ' LORENTZ_variance() computes the Lorentz variance;' write ( *, '(a)' ) ' LORENTZ_sample() samples the Lorentz distribution.' call lorentz_mean ( mean ) call lorentz_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call lorentz_sample ( x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine maxwell_cdf_test ( ) !*****************************************************************************80 ! !! MAXWELL_CDF_test() tests MAXWELL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf integer i logical maxwell_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'MAXWELL_CDF_test():' write ( *, '(a)' ) ' MAXWELL_CDF evaluates the Maxwell CDF.' write ( *, '(a)' ) ' MAXWELL_CDF_INV inverts the Maxwell CDF.' write ( *, '(a)' ) ' MAXWELL_PDF evaluates the Maxwell PDF.' a = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. maxwell_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'MAXWELL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call maxwell_sample ( a, x ) call maxwell_pdf ( x, a, pdf ) call maxwell_cdf ( x, a, cdf ) call maxwell_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine maxwell_sample_test ( ) !*****************************************************************************80 ! !! MAXWELL_SAMPLE_test() tests MAXWELL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a integer i logical maxwell_check real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'MAXWELL_SAMPLE_test():' write ( *, '(a)' ) ' MAXWELL_mean() computes the Maxwell mean;' write ( *, '(a)' ) ' MAXWELL_variance() computes the Maxwell variance;' write ( *, '(a)' ) ' MAXWELL_sample() samples the Maxwell distribution.' a = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. maxwell_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'MAXWELL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call maxwell_mean ( a, mean ) call maxwell_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF mean = ', variance do i = 1, sample_num call maxwell_sample ( a, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine multinomial_coef_test ( ) !*****************************************************************************80 ! !! MULTINOMIAL_test() tests MULTINOMIAL_COEF1, MULTINOMIAL_COEF2. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: maxfactor = 5 integer factor(maxfactor) integer i integer j integer n integer ncomb1 integer ncomb2 integer nfactor write ( *, '(a)' ) '' write ( *, '(a)' ) 'MULTINOMIAL_test():' write ( *, '(a)' ) ' MULTINOMIAL_COEF1 computes multinomial' write ( *, '(a)' ) ' coefficients using the Gamma function;' write ( *, '(a)' ) ' MULTINOMIAL_COEF2 computes multinomial' write ( *, '(a)' ) ' coefficients directly.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' Line 10 of the BINOMIAL table:' write ( *, '(a)' ) '' n = 10 nfactor = 2 do i = 0, n factor(1) = i factor(2) = n - i call multinomial_coef1 ( nfactor, factor, ncomb1 ) call multinomial_coef2 ( nfactor, factor, ncomb2 ) write ( *, '(i4,i4,3x,i5,i5)' ) factor(1), factor(2), ncomb1, ncomb2 end do write ( *, '(a)' ) '' write ( *, '(a)' ) ' Level 5 of the TRINOMIAL coefficients:' n = 5 nfactor = 3 do i = 0, n factor(1) = i write ( *, '(a)' ) '' do j = 0, n - factor(1) factor(2) = j factor(3) = n - factor(1) - factor(2) call multinomial_coef1 ( nfactor, factor, ncomb1 ) call multinomial_coef2 ( nfactor, factor, ncomb2 ) write ( *, '(i4,i4,i4,3x,i5,i5)' ) factor(1), factor(2), factor(3), & ncomb1, ncomb2 end do end do return end subroutine multinomial_sample_test ( ) !*****************************************************************************80 ! !! MULTINOMIAL_SAMPLE_test() tests MULTINOMIAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: b = 3 integer, parameter :: sample_num = 1000 integer a real ( kind = rk ) c(b) integer i real ( kind = rk ) mean(b) logical multinomial_check real ( kind = rk ) variance(b) integer x(b,sample_num) integer xmax(b) integer xmin(b) write ( *, '(a)' ) '' write ( *, '(a)' ) 'MULTINOMIAL_SAMPLE_test():' write ( *, '(a)' ) ' MULTINOMIAL_mean() computes the Multinomial mean;' write ( *, '(a)' ) ' MULTINOMIAL_sample() samples the Multinomial distribution;' write ( *, '(a)' ) ' MULTINOMIAL_variance() computes the Multinomial variance;' a = 5 c(1:3) = (/ 0.125D+00, 0.500D+00, 0.375D+00 /) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,i8)' ) ' PDF parameter B = ', b call r8vec_print ( b, c, ' PDF parameter C = ' ) if ( .not. multinomial_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'MULTINOMIAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call multinomial_mean ( a, b, c, mean ) call multinomial_variance ( a, b, c, variance ) call r8vec_print ( b, mean, ' PDF means: ' ) call r8vec_print ( b, variance, ' PDF variances:' ) do i = 1, sample_num call multinomial_sample ( a, b, c, x(1,i) ) end do call i4row_max ( b, sample_num, x, xmax ) call i4row_min ( b, sample_num, x, xmin ) call i4row_mean ( b, sample_num, x, mean ) call i4row_variance ( b, sample_num, x, variance ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a)' ) ' Component Mean, Variance, Min, Max:' do i = 1, b write ( *, '(2x,i8,2g14.6,2i8)' ) i, mean(i), variance(i), xmin(i), xmax(i) end do return end subroutine multinomial_pdf_test ( ) !*****************************************************************************80 ! !! MULTINOMIAL_PDF_test() tests MULTINOMIAL_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: b = 3 integer a real ( kind = rk ) c(b) integer i logical multinomial_check real ( kind = rk ) pdf integer x(b) write ( *, '(a)' ) '' write ( *, '(a)' ) 'MULTINOMIAL_PDF_test():' write ( *, '(a)' ) ' MULTINOMIAL_PDF evaluates the Multinomial PDF.' a = 5 c(1:3) = (/ 0.10D+00, 0.50D+00, 0.40D+00 /) write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,i8)' ) ' PDF parameter B = ', b call r8vec_print ( b, c, ' PDF parameter C:' ) if ( .not. multinomial_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'MULTINOMIAL_PDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if x(1:3) = (/ 0, 2, 3 /) write ( *, '(a)' ) '' write ( *, '(a)' ) ' PDF argument X:' write ( *, '(a)' ) '' do i = 1, b write ( *, '(2x,i8)' ) x(i) end do call multinomial_pdf ( x, a, b, c, pdf ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF value = ', pdf return end subroutine multinoulli_pdf_test ( ) !*****************************************************************************80 ! !! MULTINOULLLI_PDF_test() tests MULTINOULLI_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 19 September 2018 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 5 real ( kind = rk ) pdf real ( kind = rk ) theta(n) real ( kind = rk ) theta_sum integer x write ( *, '(a)' ) '' write ( *, '(a)' ) 'MULTINOULLI_PDF_test():' write ( *, '(a)' ) ' MULTINOULLI_PDF evaluates the Multinoulli PDF.' call random_number ( harvest = theta(1:n) ) theta_sum = sum ( theta(1:n) ) theta(1:n) = theta(1:n) / theta_sum; write ( *, '(a)' ) '' write ( *, '(a)' ) ' X pdf(X)' write ( *, '(a)' ) '' do x = 0, n + 1 call multinoulli_pdf ( x, n, theta, pdf ) write ( *, '(2x,i2,2x,g14.6)' ) x, pdf end do return end subroutine nakagami_cdf_test ( ) !*****************************************************************************80 ! !! NAKAGAMI_CDF_test() tests NAKAGAMI_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 August 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf integer i logical nakagami_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NAKAGAMI_CDF_test():' write ( *, '(a)' ) ' NAKAGAMI_CDF evaluates the Nakagami CDF;' write ( *, '(a)' ) ' NAKAGAMI_PDF evaluates the Nakagami PDF;' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. nakagami_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'NAKAGAMI_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 x = a + b + sqrt ( real ( i, kind = rk ) / c / 10.0D+00 ) call nakagami_pdf ( x, a, b, c, pdf ) call nakagami_cdf ( x, a, b, c, cdf ) call nakagami_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine nakagami_sample_test ( ) !*****************************************************************************80 ! !! NAKAGAMI_SAMPLE_test() tests NAKAGAMI_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 13 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) mean logical nakagami_check real ( kind = rk ) variance write ( *, '(a)' ) '' write ( *, '(a)' ) 'NAKAGAMI_SAMPLE_test():' write ( *, '(a)' ) ' NAKAGAMI_mean() computes the Nakagami mean;' write ( *, '(a)' ) ' NAKAGAMI_variance() computes the Nakagami variance.' a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. nakagami_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'NAKAGAMI_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call nakagami_mean ( a, b, c, mean ) call nakagami_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance return end subroutine negative_binomial_cdf_test ( ) !*****************************************************************************80 ! !! NEGATIVE_BINOMIAL_CDF_test() tests NEGATIVE_BINOMIAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical negative_binomial_check real ( kind = rk ) pdf integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NEGATIVE_BINOMIAL_CDF_test():' write ( *, '(a)' ) ' NEGATIVE_BINOMIAL_CDF evaluates the Negative Binomial CDF.' write ( *, '(a)' ) ' NEGATIVE_BINOMIAL_CDF_INV inverts the Negative Binomial CDF.' write ( *, '(a)' ) ' NEGATIVE_BINOMIAL_PDF evaluates the Negative Binomial PDF.' a = 2 b = 0.25D+00 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. negative_binomial_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'NEGATIVE_BINOMIAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call negative_binomial_sample ( a, b, x ) call negative_binomial_pdf ( x, a, b, pdf ) call negative_binomial_cdf ( x, a, b, cdf ) call negative_binomial_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine negative_binomial_sample_test ( ) !*****************************************************************************80 ! !! NEGATIVE_BINOMIAL_SAMPLE_test() tests NEGATIVE_BINOMIAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer a real ( kind = rk ) b integer i real ( kind = rk ) mean logical negative_binomial_check real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'NEGATIVE_BINOMIAL_SAMPLE_test():' write ( *, '(a)' ) ' NEGATIVE_BINOMIAL_mean() computes the Negative Binomial mean;' write ( *, '(a)' ) ' NEGATIVE_BINOMIAL_sample() samples the Negative Binomial distribution;' write ( *, '(a)' ) ' NEGATIVE_BINOMIAL_variance() computes the Negative Binomial variance.' a = 2 b = 0.75D+00 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. negative_binomial_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'NEGATIVE_BINOMIAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call negative_binomial_mean ( a, b, mean ) call negative_binomial_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call negative_binomial_sample ( a, b, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine normal_01_cdf_test ( ) !*****************************************************************************80 ! !! NORMAL_01_CDF_test() tests NORMAL_01_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf real ( kind = rk ) pdf integer i real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_01_CDF_test():' write ( *, '(a)' ) ' NORMAL_01_CDF evaluates the Normal 01 CDF;' write ( *, '(a)' ) ' NORMAL_01_CDF_INV inverts the Normal 01 CDF.' write ( *, '(a)' ) ' NORMAL_01_PDF evaluates the Normal 01 PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call normal_01_sample ( x ) call normal_01_pdf ( x, pdf ) call normal_01_cdf ( x, cdf ) call normal_01_cdf_inv ( cdf, x2 ) write ( *, '(2x,g24.16,2x,g14.6,2x,g14.6,2x,g24.16)' ) x, pdf, cdf, x2 end do return end subroutine normal_01_samples_test ( ) !*****************************************************************************80 ! !! NORMAL_01_SAMPLES_test() tests NORMAL_01_SAMPLES. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) mean real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_01_SAMPLES_test():' write ( *, '(a)' ) ' NORMAL_01_mean() computes the Normal 01 mean;' write ( *, '(a)' ) ' NORMAL_01_SAMPLES samples the Normal 01 PDF;' write ( *, '(a)' ) ' NORMAL_01_VARIANCE returns the Normal 01 variance.' call normal_01_mean ( mean ) call normal_01_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance call normal_01_samples ( sample_num, x ) call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine normal_cdf_test ( ) !*****************************************************************************80 ! !! NORMAL_CDF_test() tests NORMAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i logical normal_check real ( kind = rk ) mu real ( kind = rk ) pdf real ( kind = rk ) sigma real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_CDF_test():' write ( *, '(a)' ) ' NORMAL_CDF evaluates the Normal CDF;' write ( *, '(a)' ) ' NORMAL_CDF_INV inverts the Normal CDF.' write ( *, '(a)' ) ' NORMAL_PDF evaluates the Normal PDF;' mu = 100.0D+00 sigma = 15.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter MU = ', mu write ( *, '(a,g14.6)' ) ' PDF parameter SIGMA = ', sigma if ( .not. normal_check ( mu, sigma ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call normal_sample ( mu, sigma, x ) call normal_pdf ( x, mu, sigma, pdf ) call normal_cdf ( x, mu, sigma, cdf ) call normal_cdf_inv ( cdf, mu, sigma, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine normal_samples_test ( ) !*****************************************************************************80 ! !! NORMAL_SAMPLES_test() tests NORMAL_SAMPLES. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 logical normal_check real ( kind = rk ) mean real ( kind = rk ) mu real ( kind = rk ) sigma real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_SAMPLES_test():' write ( *, '(a)' ) ' NORMAL_mean() computes the Normal mean;' write ( *, '(a)' ) ' NORMAL_SAMPLES samples the Normal distribution;' write ( *, '(a)' ) ' NORMAL_VARIANCE returns the Normal variance.' mu = 100.0D+00 sigma = 15.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter MU = ', mu write ( *, '(a,g14.6)' ) ' PDF parameter SIGMA = ', sigma if ( .not. normal_check ( mu, sigma ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call normal_mean ( mu, sigma, mean ) call normal_variance ( mu, sigma, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance call normal_samples ( sample_num, mu, sigma, x ) call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine normal_truncated_ab_cdf_test ( ) !*****************************************************************************80 ! !! NORMAL_TRUNCATED_AB_CDF_test() tests NORMAL_TRUNCATED_AB_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) mu real ( kind = rk ) pdf real ( kind = rk ) s real ( kind = rk ) x real ( kind = rk ) x2 a = 50.0D+00 b = 150.0D+00 mu = 100.0D+00 s = 25.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_TRUNCATED_AB_CDF_test():' write ( *, '(a)' ) ' NORMAL_TRUNCATED_AB_CDF evaluates the Normal Truncated AB CDF.' write ( *, '(a)' ) ' NORMAL_TRUNCATED_AB_CDF_INV inverts the Normal Truncated AB CDF.' write ( *, '(a)' ) ' NORMAL_TRUNCATED_AB_PDF evaluates the Normal Truncated AB PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' The "parent" normal distribution has' write ( *, '(a,g14.6)' ) ' mean = ', mu write ( *, '(a,g14.6)' ) ' standard deviation = ', s write ( *, '(a)' ) ' The parent distribution is truncated to' write ( *, '(a,g14.6,a,g14.6,a)' ) ' the interval [', a, ',', b, ']' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call normal_truncated_ab_sample ( mu, s, a, b, x ) call normal_truncated_ab_pdf ( x, mu, s, a, b, pdf ) call normal_truncated_ab_cdf ( x, mu, s, a, b, cdf ) call normal_truncated_ab_cdf_inv ( cdf, mu, s, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine normal_truncated_ab_sample_test ( ) !*****************************************************************************80 ! !! NORMAL_TRUNCATED_AB_SAMPLE_test() tests NORMAL_TRUNCATED_AB_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean real ( kind = rk ) mu real ( kind = rk ) s real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin a = 50.0D+00 b = 150.0D+00 mu = 100.0D+00 s = 25.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_TRUNCATED_AB_SAMPLE_test():' write ( *, '(a)' ) ' NORMAL_TRUNCATED_AB_mean() computes the Normal Truncated AB mean;' write ( *, '(a)' ) ' NORMAL_TRUNCATED_AB_sample() samples the Normal Truncated AB distribution;' write ( *, '(a)' ) ' NORMAL_TRUNCATED_AB_variance() computes the Normal Truncated AB variance.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' The "parent" normal distribution has' write ( *, '(a,g14.6)' ) ' mean = ', mu write ( *, '(a,g14.6)' ) ' standard deviation = ', s write ( *, '(a)' ) ' The parent distribution is truncated to' write ( *, '(a,g14.6,a,g14.6,a)' ) ' the interval [', a, ',', b, ']' call normal_truncated_ab_mean ( mu, s, a, b, mean ) call normal_truncated_ab_variance ( mu, s, a, b, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call normal_truncated_ab_sample ( mu, s, a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine normal_truncated_a_cdf_test ( ) !*****************************************************************************80 ! !! NORMAL_TRUNCATED_A_CDF_test() tests NORMAL_TRUNCATED_A_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf integer i real ( kind = rk ) mu real ( kind = rk ) pdf real ( kind = rk ) s real ( kind = rk ) x real ( kind = rk ) x2 a = 50.0D+00 mu = 100.0D+00 s = 25.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_TRUNCATED_A_CDF_test():' write ( *, '(a)' ) ' NORMAL_TRUNCATED_A_CDF evaluates the Normal Truncated A CDF.' write ( *, '(a)' ) ' NORMAL_TRUNCATED_A_CDF_INV inverts the Normal Truncated A CDF.' write ( *, '(a)' ) ' NORMAL_TRUNCATED_A_PDF evaluates the Normal Truncated A PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' The "parent" normal distribution has' write ( *, '(a,g14.6)' ) ' mean = ', mu write ( *, '(a,g14.6)' ) ' standard deviation = ', s write ( *, '(a)' ) ' The parent distribution is truncated to' write ( *, '(a,g14.6,a)' ) ' the interval [', a, ',+oo]' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call normal_truncated_a_sample ( mu, s, a, x ) call normal_truncated_a_pdf ( x, mu, s, a, pdf ) call normal_truncated_a_cdf ( x, mu, s, a, cdf ) call normal_truncated_a_cdf_inv ( cdf, mu, s, a, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine normal_truncated_a_sample_test ( ) !*****************************************************************************80 ! !! NORMAL_TRUNCATED_A_SAMPLE_test() tests NORMAL_TRUNCATED_A_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a integer i real ( kind = rk ) mean real ( kind = rk ) mu real ( kind = rk ) s real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin a = 50.0D+00 mu = 100.0D+00 s = 25.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_TRUNCATED_A_SAMPLE_test():' write ( *, '(a)' ) ' NORMAL_TRUNCATED_A_mean() computes the Normal Truncated A mean;' write ( *, '(a)' ) ' NORMAL_TRUNCATED_A_sample() samples the Normal Truncated A distribution;' write ( *, '(a)' ) ' NORMAL_TRUNCATED_A_variance() computes the Normal Truncated A variance.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' The "parent" normal distribution has' write ( *, '(a,g14.6)' ) ' mean = ', mu write ( *, '(a,g14.6)' ) ' standard deviation = ', s write ( *, '(a)' ) ' The parent distribution is truncated to' write ( *, '(a,g14.6,a)' ) ' the interval [', a, ',+oo]' call normal_truncated_a_mean ( mu, s, a, mean ) call normal_truncated_a_variance ( mu, s, a, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call normal_truncated_a_sample ( mu, s, a, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine normal_truncated_b_cdf_test ( ) !*****************************************************************************80 ! !! NORMAL_TRUNCATED_B_CDF_test() tests NORMAL_TRUNCATED_B_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) mu real ( kind = rk ) pdf real ( kind = rk ) s real ( kind = rk ) x real ( kind = rk ) x2 b = 150.0D+00 mu = 100.0D+00 s = 25.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_TRUNCATED_B_CDF_test():' write ( *, '(a)' ) ' NORMAL_TRUNCATED_B_CDF evaluates the Normal Truncated B CDF.' write ( *, '(a)' ) ' NORMAL_TRUNCATED_B_CDF_INV inverts the Normal Truncated B CDF.' write ( *, '(a)' ) ' NORMAL_TRUNCATED_B_PDF evaluates the Normal Truncated B PDF.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' The "parent" normal distribution has' write ( *, '(a,g14.6)' ) ' mean = ', mu write ( *, '(a,g14.6)' ) ' standard deviation = ', s write ( *, '(a)' ) ' The parent distribution is truncated to' write ( *, '(a,g14.6,a)' ) ' the interval [-oo,', b, ']' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call normal_truncated_b_sample ( mu, s, b, x ) call normal_truncated_b_pdf ( x, mu, s, b, pdf ) call normal_truncated_b_cdf ( x, mu, s, b, cdf ) call normal_truncated_b_cdf_inv ( cdf, mu, s, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine normal_truncated_b_sample_test ( ) !*****************************************************************************80 ! !! NORMAL_TRUNCATED_B_SAMPLE_test() tests NORMAL_TRUNCATED_B_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) b integer i real ( kind = rk ) mean real ( kind = rk ) mu real ( kind = rk ) s real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin b = 150.0D+00 mu = 100.0D+00 s = 25.0D+00 write ( *, '(a)' ) '' write ( *, '(a)' ) 'NORMAL_TRUNCATED_B_SAMPLE_test():' write ( *, '(a)' ) ' NORMAL_TRUNCATED_B_mean() computes the Normal Truncated B mean;' write ( *, '(a)' ) ' NORMAL_TRUNCATED_B_sample() samples the Normal Truncated B distribution;' write ( *, '(a)' ) ' NORMAL_TRUNCATED_B_variance() computes the Normal Truncated B variance.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' The "parent" normal distribution has' write ( *, '(a,g14.6)' ) ' mean = ', mu write ( *, '(a,g14.6)' ) ' standard deviation = ', s write ( *, '(a)' ) ' The parent distribution is truncated to' write ( *, '(a,g14.6,a)' ) ' the interval [-oo,', b, ']' call normal_truncated_b_mean ( mu, s, b, mean ) call normal_truncated_b_variance ( mu, s, b, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call normal_truncated_b_sample ( mu, s, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine pareto_cdf_test ( ) !*****************************************************************************80 ! !! PARETO_CDF_test() tests PARETO_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i logical pareto_check real ( kind = rk ) pdf real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'PARETO_CDF_test():' write ( *, '(a)' ) ' PARETO_CDF evaluates the Pareto CDF;' write ( *, '(a)' ) ' PARETO_CDF_INV inverts the Pareto CDF.' write ( *, '(a)' ) ' PARETO_PDF evaluates the Pareto PDF;' a = 0.5D+00 b = 5.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. pareto_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'PARETO_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call pareto_sample ( a, b, x ) call pareto_pdf ( x, a, b, pdf ) call pareto_cdf ( x, a, b, cdf ) call pareto_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine pareto_sample_test !*****************************************************************************80 ! !! PARETO_SAMPLE_test() tests PARETO_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical pareto_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'PARETO_SAMPLE_test():' write ( *, '(a)' ) ' PARETO_mean() computes the Pareto mean;' write ( *, '(a)' ) ' PARETO_sample() samples the Pareto distribution;' write ( *, '(a)' ) ' PARETO_variance() computes the Pareto variance.' a = 0.5D+00 b = 5.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. pareto_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'PARETO_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call pareto_mean ( a, b, mean ) call pareto_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call pareto_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine pearson_05_pdf_test ( ) !*****************************************************************************80 ! !! PEARSON_05_PDF_test() tests PEARSON_05_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) pdf logical pearson_05_check real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'PEARSON_05_PDF_test():' write ( *, '(a)' ) ' PEARSON_05_PDF evaluates the Pearson 05 PDF.' x = 5.0D+00 a = 1.0D+00 b = 2.0D+00 c = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. pearson_05_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'PEARSON_05_PDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call pearson_05_pdf ( x, a, b, c, pdf ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value = ', pdf return end subroutine planck_pdf_test ( ) !*****************************************************************************80 ! !! PLANCK_PDF_test() tests PLANCK_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) pdf logical planck_check real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'PLANCK_PDF_test():' write ( *, '(a)' ) ' PLANCK_PDF evaluates the Planck PDF.' write ( *, '(a)' ) ' PLANCK_sample() samples the Planck PDF.' a = 2.0D+00; b = 3.0D+00; write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. planck_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'PLANCK_PDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF' write ( *, '(a)' ) '' do i = 1, 10 call planck_sample ( a, b, x ) call planck_pdf ( x, a, b, pdf ) write ( *, '(2x,2g14.6)' ) x, pdf end do return end subroutine planck_sample_test ( ) !*****************************************************************************80 ! !! PLANCK_SAMPLE_test() tests PLANCK_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical planck_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'PLANCK_SAMPLE_test():' write ( *, '(a)' ) ' PLANCK_mean() computes the Planck mean.' write ( *, '(a)' ) ' PLANCK_sample() samples the Planck distribution.' write ( *, '(a)' ) ' PLANCK_variance() computes the Planck variance.' write ( *, '(a)' ) '' a = 2.0D+00; b = 3.0D+00; write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. planck_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'PLANCK_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call planck_mean ( a, b, mean ) call planck_variance ( a, b, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call planck_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine poisson_cdf_test ( ) !*****************************************************************************80 ! !! POISSON_CDF_test() tests POISSON_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical poisson_check integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'POISSON_CDF_test():' write ( *, '(a)' ) ' POISSON_CDF evaluates the Poisson CDF,' write ( *, '(a)' ) ' POISSON_CDF_INV inverts the Poisson CDF.' write ( *, '(a)' ) ' POISSON_PDF evaluates the Poisson PDF.' a = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. poisson_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'POISSON_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call poisson_sample ( a, x ) call poisson_pdf ( x, a, pdf ) call poisson_cdf ( x, a, cdf ) call poisson_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine poisson_sample_test ( ) !*****************************************************************************80 ! !! POISSON_SAMPLE_test() tests POISSON_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a integer i real ( kind = rk ) mean logical poisson_check real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'POISSON_SAMPLE_test():' write ( *, '(a)' ) ' POISSON_mean() computes the Poisson mean;' write ( *, '(a)' ) ' POISSON_sample() samples the Poisson distribution;' write ( *, '(a)' ) ' POISSON_variance() computes the Poisson variance.' a = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. poisson_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'POISSON_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call poisson_mean ( a, mean ) call poisson_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call poisson_sample ( a, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine power_cdf_test ( ) !*****************************************************************************80 ! !! POWER_CDF_test() tests POWER_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 28 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical power_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'POWER_CDF_test():' write ( *, '(a)' ) ' POWER_CDF evaluates the Power CDF;' write ( *, '(a)' ) ' POWER_CDF_INV inverts the Power CDF.' write ( *, '(a)' ) ' POWER_PDF evaluates the Power PDF;' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. power_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'POWER_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call power_sample ( a, b, x ) call power_pdf ( x, a, b, pdf ) call power_cdf ( x, a, b, cdf ) call power_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine power_sample_test ( ) !*****************************************************************************80 ! !! POWER_SAMPLE_test() tests POWER_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 24 April 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical power_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'POWER_SAMPLE_test():' write ( *, '(a)' ) ' POWER_mean() computes the Power mean;' write ( *, '(a)' ) ' POWER_sample() samples the Power distribution;' write ( *, '(a)' ) ' POWER_variance() computes the Power variance.' a = 2.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. power_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'POWER_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call power_mean ( a, b, mean ) call power_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call power_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine quasigeometric_cdf_test ( ) !*****************************************************************************80 ! !! QUASIGEOMETRIC_CDF_test() tests QUASIGEOMETRIC_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical quasigeometric_check integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'QUASIGEOMETRIC_CDF_test():' write ( *, '(a)' ) ' QUASIGEOMETRIC_CDF evaluates the Quasigeometric CDF;' write ( *, '(a)' ) ' QUASIGEOMETRIC_CDF_INV inverts the Quasigeometric CDF.' write ( *, '(a)' ) ' QUASIGEOMETRIC_PDF evaluates the Quasigeometric PDF;' a = 0.4825D+00 b = 0.5893D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. quasigeometric_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'QUASIGEOMETRIC_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call quasigeometric_sample ( a, b, x ) call quasigeometric_pdf ( x, a, b, pdf ) call quasigeometric_cdf ( x, a, b, cdf ) call quasigeometric_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine quasigeometric_sample_test ( ) !*****************************************************************************80 ! !! QUASIGEOMETRIC_SAMPLE_test() tests QUASIGEOMETRIC_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical quasigeometric_check real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'QUASIGEOMETRIC_SAMPLE_test():' write ( *, '(a)' ) ' QUASIGEOMETRIC_mean() computes the Quasigeometric mean;' write ( *, '(a)' ) ' QUASIGEOMETRIC_sample() samples the Quasigeometric distribution;' write ( *, '(a)' ) ' QUASIGEOMETRIC_variance() computes the Quasigeometric variance.' a = 0.4825D+00 b = 0.5893D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. quasigeometric_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'QUASIGEOMETRIC_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call quasigeometric_mean ( a, b, mean ) call quasigeometric_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call quasigeometric_sample ( a, b, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine r8_beta_test ( ) !*****************************************************************************80 ! !! R8_BETA_test() tests R8_BETA. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) fxy1 real ( kind = rk ) fxy2 integer n_data real ( kind = rk ) r8_beta real ( kind = rk ) x real ( kind = rk ) y write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_BETA_TEST:' write ( *, '(a)' ) ' R8_BETA evaluates the Beta function.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X Y BETA(X,Y) R8_BETA(X,Y)' write ( *, '(a)' ) ' tabulated computed' write ( *, '(a)' ) '' n_data = 0 do call beta_values ( n_data, x, y, fxy1 ) if ( n_data == 0 ) then exit end if fxy2 = r8_beta ( x, y ) write ( *, '(2x,f14.6,2x,f14.6,2x,g24.16,2x,g24.16)' ) x, y, fxy1, fxy2 end do return end subroutine r8_ceiling_test ( ) !*****************************************************************************80 ! !! R8_CEILING_test() tests R8_CEILING. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer i integer r8_ceiling integer ival real ( kind = rk ) rval write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_CEILING_test():' write ( *, '(a)' ) ' R8_CEILING rounds an R8 up.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X R8_CEILING(X)' write ( *, '(a)' ) '' do i = -6, 6 rval = real ( i, kind = rk ) / 5.0D+00 ival = r8_ceiling ( rval ) write ( *, '(2x,g14.6,i8)' ) rval, ival end do return end subroutine r8_error_f_test ( ) !*****************************************************************************80 ! !! R8_ERROR_F_test() tests R8_ERROR_F. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer i real ( kind = rk ) r8_error_f real ( kind = rk ) r8_error_f_inverse real ( kind = rk ) x real ( kind = rk ) y real ( kind = rk ) z write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_ERROR_F_test():' write ( *, '(a)' ) ' R8_ERROR_F evaluates the error function erf(x).' write ( *, '(a)' ) '' write ( *, '(a)' ) 'X -> Y = R8_ERROR_F(X) -> Z = R8_ERROR_F_INVERSE(Y)' write ( *, '(a)' ) '' do i = 1, 20 call normal_01_sample ( x ) y = r8_error_f ( x ) z = r8_error_f_inverse ( y ) write ( *, '(2x,g14.6,2x,g14.6,2x,g14.6)' ) x, y, z end do return end subroutine r8_factorial_test ( ) !*****************************************************************************80 ! !! R8_FACTORIAL_test() tests R8_FACTORIAL. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) g integer i real ( kind = rk ) r8_factorial write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_FACTORIAL_test():' write ( *, '(a)' ) ' R8_FACTORIAL evaluates the factorial function.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' I R8_FACTORIAL(I)' write ( *, '(a)' ) '' do i = 0, 20 g = r8_factorial ( i ) write ( *, '(2x,i8,2x,g14.6)' ) i, g end do return end subroutine r8_gamma_inc_test ( ) !*****************************************************************************80 ! !! R8_GAMMA_INC_test() tests R8_GAMMA_INC. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 07 January 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) fx real ( kind = rk ) fx2 integer n_data real ( kind = rk ) r8_gamma_inc real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_GAMMA_INC_TEST:' write ( *, '(a)' ) ' R8_GAMMA_INC evaluates the normalized incomplete Gamma' write ( *, '(a)' ) ' function P(A,X).' write ( *, '(a)' ) '' write ( *, '(a)' ) ' A X Exact F R8_GAMMA_INC(A,X)' write ( *, '(a)' ) '' n_data = 0 do call gamma_inc_values ( n_data, a, x, fx ) if ( n_data == 0 ) then exit end if fx2 = r8_gamma_inc ( a, x ) write ( *, '(2x,2f8.4,2g14.6)' ) a, x, fx, fx2 end do return end subroutine r8_gamma_log_int_test ( ) !*****************************************************************************80 ! !! R8_GAMMA_LOG_INT_test() tests R8_GAMMA_LOG_INT; ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) g integer i real ( kind = rk ) r8_gamma_log_int write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_GAMMA_LOG_INT_test():' write ( *, '(a)' ) ' R8_GAMMA_LOG_INT evaluates the logarithm of the' write ( *, '(a)' ) ' gamma function for integer argument.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' I R8_GAMMA_LOG_INT(I)' write ( *, '(a)' ) '' do i = 1, 20 g = r8_gamma_log_int ( i ) write ( *, '(2x,i8,2x,g14.6)' ) i, g end do return end subroutine r8_zeta_test ( ) !*****************************************************************************80 ! !! R8_ZETA_test() tests R8_ZETA. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer i real ( kind = rk ) p real ( kind = rk ) r8_zeta real ( kind = rk ) v write ( *, '(a)' ) '' write ( *, '(a)' ) 'R8_ZETA_test():' write ( *, '(a)' ) ' R8_ZETA estimates the Zeta function.' write ( *, '(a)' ) '' write ( *, '(a)' ) ' P R8_Zeta(P)' write ( *, '(a)' ) '' do i = 1, 25 p = real ( i, kind = rk ) v = r8_zeta ( p ) write ( *, '(2x,f6.0,2x,g14.6)' ) p, v end do write ( *, '(a)' ) '' do i = 0, 8 p = 3.0 + real ( i, kind = rk ) / 8.0D+00 v = r8_zeta ( p ); write ( *, '(2x,f6.0,2x,g14.6)' ) p, v end do return end subroutine rayleigh_cdf_test ( ) !*****************************************************************************80 ! !! RAYLEIGH_CDF_test() tests RAYLEIGH_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 28 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical rayleigh_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'RAYLEIGH_CDF_test():' write ( *, '(a)' ) ' RAYLEIGH_CDF evaluates the Rayleigh CDF;' write ( *, '(a)' ) ' RAYLEIGH_CDF_INV inverts the Rayleigh CDF.' write ( *, '(a)' ) ' RAYLEIGH_PDF evaluates the Rayleigh PDF;' a = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. rayleigh_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'RAYLEIGH_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call rayleigh_sample ( a, x ) call rayleigh_pdf ( x, a, pdf ) call rayleigh_cdf ( x, a, cdf ) call rayleigh_cdf_inv ( cdf, a, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine rayleigh_sample_test ( ) !*****************************************************************************80 ! !! RAYLEIGH_SAMPLE_test() tests RAYLEIGH_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 28 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a integer i real ( kind = rk ) mean logical rayleigh_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'RAYLEIGH_SAMPLE_test():' write ( *, '(a)' ) ' RAYLEIGH_mean() computes the Rayleigh mean;' write ( *, '(a)' ) ' RAYLEIGH_sample() samples the Rayleigh distribution;' write ( *, '(a)' ) ' RAYLEIGH_variance() computes the Rayleigh variance.' a = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. rayleigh_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'RAYLEIGH_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call rayleigh_mean ( a, mean ) call rayleigh_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call rayleigh_sample ( a, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine reciprocal_cdf_test ( ) !*****************************************************************************80 ! !! RECIPROCAL_CDF_test() tests RECIPROCAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 29 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical reciprocal_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'RECIPROCAL_CDF_test():' write ( *, '(a)' ) ' RECIPROCAL_CDF evaluates the Reciprocal CDF.' write ( *, '(a)' ) ' RECIPROCAL_CDF_INV inverts the Reciprocal CDF.' write ( *, '(a)' ) ' RECIPROCAL_PDF evaluates the Reciprocal PDF.' a = 1.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. reciprocal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'RECIPROCAL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call reciprocal_sample ( a, b, x ) call reciprocal_pdf ( x, a, b, pdf ) call reciprocal_cdf ( x, a, b, cdf ) call reciprocal_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine reciprocal_sample_test ( ) !*****************************************************************************80 ! !! RECIPROCAL_SAMPLE_test() tests RECIPROCAL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 29 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical reciprocal_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'RECIPROCAL_SAMPLE_test():' write ( *, '(a)' ) ' RECIPROCAL_mean() computes the Reciprocal mean;' write ( *, '(a)' ) ' RECIPROCAL_sample() samples the Reciprocal distribution;' write ( *, '(a)' ) ' RECIPROCAL_variance() computes the Reciprocal variance.' a = 1.0D+00 b = 3.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. reciprocal_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'RECIPROCAL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call reciprocal_mean ( a, b, mean ) call reciprocal_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call reciprocal_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine runs_pdf_test ( ) !*****************************************************************************80 ! !! RUNS_PDF_test() tests RUNS_PDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer m integer n real ( kind = rk ) pdf real ( kind = rk ) pdf_total integer r write ( *, '(a)' ) '' write ( *, '(a)' ) 'RUNS_PDF_test():' write ( *, '(a)' ) ' RUNS_PDF evaluates the Runs PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' M is the number of symbols of one kind,' write ( *, '(a)' ) ' N is the number of symbols of the other kind,' write ( *, '(a)' ) ' R is the number of runs (sequences of one symbol)' write ( *, '(a)' ) '' write ( *, '(a)' ) ' M N R PDF' write ( *, '(a)' ) '' m = 6 do n = 0, 8 write ( *, '(a)' ) '' pdf_total = 0.0D+00 do r = 1, 2 * min ( m, n ) + 2 call runs_pdf ( m, n, r, pdf ) write ( *, '(2x,i8,2x,i8,2x,i8,2x,g14.6)' ) m, n, r, pdf pdf_total = pdf_total + pdf end do write ( *, '(2x,i8,2x,8x,2x,8x,2x,g14.6)' ) m, pdf_total end do return end subroutine runs_sample_test ( ) !*****************************************************************************80 ! !! RUNS_SAMPLE_test() tests RUNS_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 03 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i integer m real ( kind = rk ) mean integer n integer r(sample_num) integer rmax integer rmin real ( kind = rk ) variance write ( *, '(a)' ) '' write ( *, '(a)' ) 'RUNS_SAMPLE_test():' write ( *, '(a)' ) ' RUNS_mean() computes the Runs mean;' write ( *, '(a)' ) ' RUNS_sample() samples the Runs distribution;' write ( *, '(a)' ) ' RUNS_variance() computes the Runs variance' m = 10 n = 5 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter M = ', m write ( *, '(a,g14.6)' ) ' PDF parameter N = ', n call runs_mean ( m, n, mean ) call runs_variance ( m, n, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call runs_sample ( m, n, r(i) ) end do call i4vec_mean ( sample_num, r, mean ) call i4vec_variance ( sample_num, r, variance ) call i4vec_max ( sample_num, r, rmax ) call i4vec_min ( sample_num, r, rmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', rmax write ( *, '(a,i8)' ) ' Sample minimum = ', rmin return end subroutine sech_cdf_test ( ) !*****************************************************************************80 ! !! SECH_CDF_test() tests SECH_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical sech_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'SECH_CDF_test():' write ( *, '(a)' ) ' SECH_CDF evaluates the Sech CDF.' write ( *, '(a)' ) ' SECH_CDF_INV inverts the Sech CDF.' write ( *, '(a)' ) ' SECH_PDF evaluates the Sech PDF.' a = 3.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. sech_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'SECH_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call sech_sample ( a, b, x ) call sech_pdf ( x, a, b, pdf ) call sech_cdf ( x, a, b, cdf ) call sech_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine sech_sample_test ( ) !*****************************************************************************80 ! !! SECH_SAMPLE_test() tests SECH_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical sech_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'SECH_SAMPLE_test():' write ( *, '(a)' ) ' SECH_mean() computes the Sech mean;' write ( *, '(a)' ) ' SECH_sample() samples the Sech distribution;' write ( *, '(a)' ) ' SECH_variance() computes the Sech variance.' a = 3.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. sech_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'SECH_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call sech_mean ( a, b, mean ) call sech_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call sech_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine semicircular_cdf_test ( ) !*****************************************************************************80 ! !! SEMICIRCULAR_CDF_test() tests SEMICIRCULAR_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 30 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical semicircular_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'SEMICIRCULAR_CDF_test():' write ( *, '(a)' ) ' SEMICIRCULAR_CDF evaluates the Semicircular CDF.' write ( *, '(a)' ) ' SEMICIRCULAR_CDF_INV inverts the Semicircular CDF.' write ( *, '(a)' ) ' SEMICIRCULAR_PDF evaluates the Semicircular PDF.' a = 3.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. semicircular_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'SEMICIRCULAR_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call semicircular_sample ( a, b, x ) call semicircular_pdf ( x, a, b, pdf ) call semicircular_cdf ( x, a, b, cdf ) call semicircular_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine semicircular_sample_test ( ) !*****************************************************************************80 ! !! SEMICIRCULAR_SAMPLE_test() tests SEMICIRCULAR_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical semicircular_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'SEMICIRCULAR_SAMPLE_test():' write ( *, '(a)' ) ' SEMICIRCULAR_mean() computes the Semicircular mean;' write ( *, '(a)' ) ' SEMICIRCULAR_sample() samples the Semicircular distribution;' write ( *, '(a)' ) ' SEMICIRCULAR_variance() computes the Semicircular variance.' a = 3.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. semicircular_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'SEMICIRCULAR_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call semicircular_mean ( a, b, mean ) call semicircular_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call semicircular_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine student_cdf_test ( ) !*****************************************************************************80 ! !! STUDENT_CDF_test() tests STUDENT_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical student_check real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'STUDENT_CDF_test():' write ( *, '(a)' ) ' STUDENT_CDF evaluates the Student CDF.' write ( *, '(a)' ) ' STUDENT_PDF evaluates the Student PDF.' write ( *, '(a)' ) ' STUDENT_sample() samples the Student PDF.' a = 0.5D+00 b = 2.0D+00 c = 6.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. student_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'STUDENT_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF' write ( *, '(a)' ) '' do i = 1, 10 call student_sample ( a, b, c, x ) call student_pdf ( x, a, b, c, pdf ) call student_cdf ( x, a, b, c, cdf ) write ( *, '(2x,g14.6,2x,g14.6,2x,g14.6)' ) x, pdf, cdf end do return end subroutine student_sample_test ( ) !*****************************************************************************80 ! !! STUDENT_SAMPLE_test() tests STUDENT_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c integer i real ( kind = rk ) mean logical student_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'STUDENT_SAMPLE_test():' write ( *, '(a)' ) ' STUDENT_mean() computes the Student mean;' write ( *, '(a)' ) ' STUDENT_sample() samples the Student distribution;' write ( *, '(a)' ) ' STUDENT_variance() computes the Student variance.' a = 0.5D+00 b = 2.0D+00 c = 6.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. student_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'STUDENT_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call student_mean ( a, b, c, mean ) call student_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call student_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine student_noncentral_cdf_test ( ) !*****************************************************************************80 ! !! STUDENT_NONCENTRAL_CDF_test() tests STUDENT_NONCENTRAL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) b real ( kind = rk ) cdf integer idf real ( kind = rk ) x write ( *, '(a)' ) '' write ( *, '(a)' ) 'STUDENT_NONCENTRAL_CDF_test():' write ( *, '(a)' ) ' STUDENT_NONCENTRAL_CDF evaluates the Student Noncentral CDF;' x = 0.50D+00 idf = 10 b = 1.0D+00 call student_noncentral_cdf ( x, idf, b, cdf ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,i8)' ) ' PDF parameter IDF = ', idf write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' CDF value = ', cdf return end subroutine tfn_test ( ) !*****************************************************************************80 ! !! TFN_test() tests TFN. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) h integer n_data real ( kind = rk ) t real ( kind = rk ) t2 real ( kind = rk ) tfn write ( *, '(a)' ) '' write ( *, '(a)' ) 'TFN_test():' write ( *, '(a)' ) ' TFN evaluates Owen''s T function;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' H A T(H,A) Exact' write ( *, '(a)' ) '' n_data = 0 do call owen_values ( n_data, h, a, t ) if ( n_data <= 0 ) then exit end if t2 = tfn ( h, a ) write ( *, '(2x,g14.6,2x,g14.6,2x,g14.6,2x,g14.6)' ) h, a, t2, t end do return end subroutine triangle_cdf_test ( ) !*****************************************************************************80 ! !! TRIANGLE_CDF_test() tests TRIANGLE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 31 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical triangle_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGLE_CDF_test():' write ( *, '(a)' ) ' TRIANGLE_CDF evaluates the Triangle CDF;' write ( *, '(a)' ) ' TRIANGLE_CDF_INV inverts the Triangle CDF.' write ( *, '(a)' ) ' TRIANGLE_PDF evaluates the Triangle PDF;' a = 1.0D+00 b = 3.0D+00 c = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. triangle_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGLE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call triangle_sample ( a, b, c, x ) call triangle_pdf ( x, a, b, c, pdf ) call triangle_cdf ( x, a, b, c, cdf ) call triangle_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine triangle_sample_test ( ) !*****************************************************************************80 ! !! TRIANGLE_SAMPLE_test() tests TRIANGLE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 31 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c integer i real ( kind = rk ) mean logical triangle_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGLE_SAMPLE_test():' write ( *, '(a)' ) ' TRIANGLE_MEAN returns the Triangle mean;' write ( *, '(a)' ) ' TRIANGLE_sample() samples the Triangle distribution;' write ( *, '(a)' ) ' TRIANGLE_VARIANCE returns the Triangle variance;' a = 1.0D+00 b = 3.0D+00 c = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. triangle_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGLE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call triangle_mean ( a, b, c, mean ) call triangle_variance ( a, b, c, variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter MEAN = ', mean write ( *, '(a,g14.6)' ) ' PDF parameter VARIANCE = ', variance do i = 1, sample_num call triangle_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine triangular_cdf_test ( ) !*****************************************************************************80 ! !! TRIANGULAR_CDF_test() tests TRIANGULAR_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 31 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical triangular_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGULAR_CDF_test():' write ( *, '(a)' ) ' TRIANGULAR_CDF evaluates the Triangular CDF;' write ( *, '(a)' ) ' TRIANGULAR_CDF_INV inverts the Triangular CDF.' write ( *, '(a)' ) ' TRIANGULAR_PDF evaluates the Triangular PDF;' a = 1.0D+00 b = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. triangular_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGULAR_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call triangular_sample ( a, b, x ) call triangular_pdf ( x, a, b, pdf ) call triangular_cdf ( x, a, b, cdf ) call triangular_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine triangular_sample_test ( ) !*****************************************************************************80 ! !! TRIANGULAR_SAMPLE_test() tests TRIANGULAR_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical triangular_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGULAR_SAMPLE_test():' write ( *, '(a)' ) ' TRIANGULAR_mean() computes the Triangular mean;' write ( *, '(a)' ) ' TRIANGULAR_sample() samples the Triangular distribution;' write ( *, '(a)' ) ' TRIANGULAR_variance() computes the Triangular variance.' a = 1.0D+00 b = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. triangular_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'TRIANGULAR_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call triangular_mean ( a, b, mean ) call triangular_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call triangular_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine uniform_01_order_sample_test ( ) !*****************************************************************************80 ! !! UNIFORM_01_ORDER_SAMPLE_test() tests UNIFORM_01_ORDER_SAMPLE; ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 10 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 10 integer i real ( kind = rk ) x(n) write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_01_ORDER_SAMPLE_test():' write ( *, '(a)' ) ' UNIFORM_ORDER_sample() samples the Uniform 01 Order distribution.' write ( *, '(a)' ) '' call uniform_01_order_sample ( n, x ) write ( *, '(a)' ) '' write ( *, '(a)' ) ' Ordered sample:' write ( *, '(a)' ) '' do i = 1, n write ( *, '(2x,i8,g14.6)' ) i, x(i) end do return end subroutine uniform_nsphere_sample_test ( ) !*****************************************************************************80 ! !! UNIFORM_NSPHERE_SAMPLE_test() tests UNIFORM_NSPHERE_SAMPLE; ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 10 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: n = 3 integer i real ( kind = rk ) x(n) write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_NSPHERE_SAMPLE_test():' write ( *, '(a)' ) ' UNIFORM_NSPHERE_sample() samples the Uniform Nsphere distribution.' write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Dimension N of sphere = ', n write ( *, '(a)' ) '' write ( *, '(a)' ) ' Points on the sphere:' write ( *, '(a)' ) '' do i = 1, 10 call uniform_nsphere_sample ( n, x ) write ( *, '(2x,i8,3g14.6)' ) i, x(1:n) end do return end subroutine uniform_01_cdf_test ( ) !*****************************************************************************80 ! !! UNIFORM_01_CDF_test() tests UNIFORM_01_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) cdf integer i real ( kind = rk ) pdf real ( kind = rk ) uniform_01_sample real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_01_CDF_test():' write ( *, '(a)' ) ' UNIFORM_01_CDF evaluates the Uniform 01 CDF;' write ( *, '(a)' ) ' UNIFORM_01_CDF_INV inverts the Uniform 01 CDF.' write ( *, '(a)' ) ' UNIFORM_01_PDF evaluates the Uniform 01 PDF;' write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 x = uniform_01_sample ( ) call uniform_01_pdf ( x, pdf ) call uniform_01_cdf ( x, cdf ) call uniform_01_cdf_inv ( cdf, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine uniform_01_sample_test ( ) !*****************************************************************************80 ! !! UNIFORM_01_SAMPLE_test() tests UNIFORM_01_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer i real ( kind = rk ) mean real ( kind = rk ) uniform_01_sample real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_01_SAMPLE_test():' write ( *, '(a)' ) ' UNIFORM_01_mean() computes the Uniform 01 mean;' write ( *, '(a)' ) ' UNIFORM_01_sample() samples the Uniform 01 distribution;' write ( *, '(a)' ) ' UNIFORM_01_variance() computes the Uniform 01 variance.' call uniform_01_mean ( mean ) call uniform_01_variance ( variance ) write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num x(i) = uniform_01_sample ( ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine uniform_cdf_test ( ) !*****************************************************************************80 ! !! UNIFORM_CDF_test() tests UNIFORM_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 27 February 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical uniform_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_CDF_test():' write ( *, '(a)' ) ' UNIFORM_CDF evaluates the Uniform CDF;' write ( *, '(a)' ) ' UNIFORM_CDF_INV inverts the Uniform CDF.' write ( *, '(a)' ) ' UNIFORM_PDF evaluates the Uniform PDF;' a = 1.0D+00 b = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. uniform_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call uniform_sample ( a, b, x ) call uniform_pdf ( x, a, b, pdf ) call uniform_cdf ( x, a, b, cdf ) call uniform_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine uniform_sample_test ( ) !*****************************************************************************80 ! !! UNIFORM_SAMPLE_test() tests UNIFORM_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 02 March 2007 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean logical uniform_check real ( kind = rk ) variance real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_SAMPLE_test():' write ( *, '(a)' ) ' UNIFORM_mean() computes the Uniform mean;' write ( *, '(a)' ) ' UNIFORM_sample() samples the Uniform distribution;' write ( *, '(a)' ) ' UNIFORM_variance() computes the Uniform variance.' a = 1.0D+00 b = 10.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. uniform_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call uniform_mean ( a, b, mean ) call uniform_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call uniform_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine uniform_discrete_cdf_test ( ) !*****************************************************************************80 ! !! tests UNIFORM_DISCRETE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer a integer b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical uniform_discrete_check integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_DISCRETE_CDF_test():' write ( *, '(a)' ) ' UNIFORM_DISCRETE_CDF evaluates the Uniform Discrete CDF;' write ( *, '(a)' ) ' UNIFORM_DISCRETE_CDF_INV inverts the Uniform Discrete CDF.' write ( *, '(a)' ) ' UNIFORM_DISCRETE_PDF evaluates the Uniform Discrete PDF;' a = 1 b = 6 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,i8)' ) ' PDF parameter B = ', b if ( .not. uniform_discrete_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_DISCRETE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call uniform_discrete_sample ( a, b, x ) call uniform_discrete_pdf ( x, a, b, pdf ) call uniform_discrete_cdf ( x, a, b, cdf ) call uniform_discrete_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine uniform_discrete_sample_test ( ) !*****************************************************************************80 ! !! UNIFORM_DISCRETE_SAMPLE_test() tests UNIFORM_DISCRETE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 integer a integer b integer i real ( kind = rk ) mean logical uniform_discrete_check real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_DISCRETE_SAMPLE_test():' write ( *, '(a)' ) ' UNIFORM_DISCRETE_mean() computes the Uniform Discrete mean;' write ( *, '(a)' ) ' UNIFORM_DISCRETE_sample() samples the Uniform Discrete distribution;' write ( *, '(a)' ) ' UNIFORM_DISCRETE_variance() computes the Uniform Discrete variance.' a = 1 b = 6 write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' PDF parameter A = ', a write ( *, '(a,i8)' ) ' PDF parameter B = ', b if ( .not. uniform_discrete_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'UNIFORM_DISCRETE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call uniform_discrete_mean ( a, b, mean ) call uniform_discrete_variance ( a, b, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call uniform_discrete_sample ( a, b, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine von_mises_cdf_test ( ) !*****************************************************************************80 ! !! VON_MISES_CDF_test() tests VON_MISES_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical von_mises_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'VON_MISES_CDF_test():' write ( *, '(a)' ) ' VON_MISES_CDF evaluates the Von Mises CDF.' write ( *, '(a)' ) ' VON_MISES_CDF_INV inverts the Von Mises CDF.' write ( *, '(a)' ) ' VON_MISES_PDF evaluates the Von Mises PDF.' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. von_mises_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'VON_MISES_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call von_mises_sample ( a, b, x ) call von_mises_pdf ( x, a, b, pdf ) call von_mises_cdf ( x, a, b, cdf ) call von_mises_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine von_mises_sample_test ( ) !*****************************************************************************80 ! !! VON_MISES_SAMPLE_test() tests VON_MISES_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 04 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean real ( kind = rk ) circular_variance logical von_mises_check real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'VON_MISES_SAMPLE_test():' write ( *, '(a)' ) ' VON_MISES_mean() computes the Von Mises mean;' write ( *, '(a)' ) ' VON_MISES_sample() samples the Von Mises distribution.' write ( *, '(a)' ) & ' VON_MISES_CIRCULAR_variance() computes the Von Mises circular_variance.' a = 1.0D+00 b = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. von_mises_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'VON_MISES_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call von_mises_mean ( a, b, mean ) call von_mises_circular_variance ( a, b, circular_variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF circular variance = ', circular_variance do i = 1, sample_num call von_mises_sample ( a, b, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_circular_variance ( sample_num, x, circular_variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample circular variance = ', circular_variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine weibull_cdf_test ( ) !*****************************************************************************80 ! !! WEIBULL_CDF_test() tests WEIBULL_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical weibull_check real ( kind = rk ) x real ( kind = rk ) x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_CDF_test():' write ( *, '(a)' ) ' WEIBULL_CDF evaluates the Weibull CDF;' write ( *, '(a)' ) ' WEIBULL_CDF_INV inverts the Weibull CDF.' write ( *, '(a)' ) ' WEIBULL_PDF evaluates the Weibull PDF;' x = 3.0D+00 a = 2.0D+00 b = 3.0D+00 c = 4.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. weibull_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call weibull_sample ( a, b, c, x ) call weibull_pdf ( x, a, b, c, pdf ) call weibull_cdf ( x, a, b, c, cdf ) call weibull_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(2x,4g14.6)' ) x, pdf, cdf, x2 end do return end subroutine weibull_sample_test ( ) !*****************************************************************************80 ! !! WEIBULL_SAMPLE_test() tests WEIBULL_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 06 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) c integer i real ( kind = rk ) mean real ( kind = rk ) variance logical weibull_check real ( kind = rk ) x(sample_num) real ( kind = rk ) xmax real ( kind = rk ) xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_SAMPLE_test():' write ( *, '(a)' ) ' WEIBULL_mean() computes the Weibull mean;' write ( *, '(a)' ) ' WEIBULL_sample() samples the Weibull distribution;' write ( *, '(a)' ) ' WEIBULL_variance() computes the Weibull variance.' a = 2.0D+00 b = 3.0D+00 c = 4.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c if ( .not. weibull_check ( a, b, c ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call weibull_mean ( a, b, c, mean ) call weibull_variance ( a, b, c, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call weibull_sample ( a, b, c, x(i) ) end do call r8vec_mean ( sample_num, x, mean ) call r8vec_variance ( sample_num, x, variance ) call r8vec_max ( sample_num, x, xmax ) call r8vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,g14.6)' ) ' Sample maximum = ', xmax write ( *, '(a,g14.6)' ) ' Sample minimum = ', xmin return end subroutine weibull_discrete_cdf_test ( ) !*****************************************************************************80 ! !! WEIBULL_DISCRETE_CDF_test() tests WEIBULL_DISCRETE_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) cdf integer i real ( kind = rk ) pdf logical weibull_discrete_check integer x integer x2 write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_DISCRETE_CDF_test():' write ( *, '(a)' ) ' WEIBULL_DISCRETE_CDF evaluates the Weibull Discrete CDF;' write ( *, '(a)' ) ' WEIBULL_DISCRETE_CDF_INV inverts the Weibull Discrete CDF.' write ( *, '(a)' ) ' WEIBULL_DISCRETE_PDF evaluates the Weibull Discrete PDF;' a = 0.50D+00 b = 1.5D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. weibull_discrete_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_DISCRETE_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF CDF CDF_INV' write ( *, '(a)' ) '' do i = 1, 10 call weibull_discrete_sample ( a, b, x ) call weibull_discrete_pdf ( x, a, b, pdf ) call weibull_discrete_cdf ( x, a, b, cdf ) call weibull_discrete_cdf_inv ( cdf, a, b, x2 ) write ( *, '(2x,i14,2g14.6,i14)' ) x, pdf, cdf, x2 end do return end subroutine weibull_discrete_sample_test ( ) !*****************************************************************************80 ! !! WEIBULL_DISCRETE_SAMPLE_test() tests WEIBULL_DISCRETE_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 08 April 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a real ( kind = rk ) b integer i real ( kind = rk ) mean real ( kind = rk ) variance logical weibull_discrete_check integer x(sample_num) integer xmax integer xmin write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_DISCRETE_SAMPLE_test():' write ( *, '(a)' ) ' WEIBULL_DISCRETE_sample() samples the Weibull Discrete PDF.' a = 0.5D+00 b = 1.5D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b if ( .not. weibull_discrete_check ( a, b ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'WEIBULL_DISCRETE_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if do i = 1, sample_num call weibull_discrete_sample ( a, b, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end subroutine zipf_cdf_test ( ) !*****************************************************************************80 ! !! ZIPF_CDF_test() tests ZIPF_CDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a real ( kind = rk ) cdf real ( kind = rk ) pdf integer x integer x2 logical zipf_check write ( *, '(a)' ) '' write ( *, '(a)' ) 'ZIPF_CDF_test():' write ( *, '(a)' ) ' ZIPF_CDF evaluates the Zipf CDF.' write ( *, '(a)' ) ' ZIPF_CDF_INV inverts the Zipf CDF.' write ( *, '(a)' ) ' ZIPF_PDF evaluates the Zipf PDF.' a = 2.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. zipf_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'ZIPF_CDF_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if write ( *, '(a)' ) '' write ( *, '(a)' ) ' X PDF(X) CDF(X) CDF_INV(CDF)' write ( *, '(a)' ) '' do x = 1, 20 call zipf_pdf ( x, a, pdf ) call zipf_cdf ( x, a, cdf ) call zipf_cdf_inv ( a, cdf, x2 ) write ( *, '(2x,i8,2x,2g14.6,2x,i8)' ) x, pdf, cdf, x2 end do return end subroutine zipf_sample_test ( ) !*****************************************************************************80 ! !! ZIPF_SAMPLE_test() tests ZIPF_SAMPLE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 March 2016 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer, parameter :: sample_num = 1000 real ( kind = rk ) a integer i real ( kind = rk ) mean real ( kind = rk ) variance integer x(sample_num) integer xmax integer xmin logical zipf_check write ( *, '(a)' ) '' write ( *, '(a)' ) 'ZIPF_SAMPLE_test():' write ( *, '(a)' ) ' ZIPF_mean() computes the mean of the Zipf distribution.' write ( *, '(a)' ) ' ZIPF_sample() samples the Zipf distribution.' write ( *, '(a)' ) ' ZIPF_variance() computes the variance of the Zipf distribution.' a = 4.0D+00 write ( *, '(a)' ) '' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a if ( .not. zipf_check ( a ) ) then write ( *, '(a)' ) '' write ( *, '(a)' ) 'ZIPF_SAMPLE_TEST - Fatal error!' write ( *, '(a)' ) ' The parameters are not legal.' return end if call zipf_mean ( a, mean ) call zipf_variance ( a, variance ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, sample_num call zipf_sample ( a, x(i) ) end do call i4vec_mean ( sample_num, x, mean ) call i4vec_variance ( sample_num, x, variance ) call i4vec_max ( sample_num, x, xmax ) call i4vec_min ( sample_num, x, xmin ) write ( *, '(a)' ) '' write ( *, '(a,i8)' ) ' Sample size = ', sample_num write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i8)' ) ' Sample maximum = ', xmax write ( *, '(a,i8)' ) ' Sample minimum = ', xmin return end