program prob_prb ! !******************************************************************************* ! !! PROB_PRB calls sample problems for the PROB routines. ! implicit none ! call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PROB_PRB' write ( *, '(a)' ) ' Sample problems for the PROB routines.' write ( *, '(a)' ) ' ' call test201 call test202 call test001 call test003 call test004 call test005 call test006 call test007 call test008 call test009 call test010 call test011 call test013 call test014 call test015 call test016 call test017 call test018 call test0185 call test019 call test020 call test021 call test022 call test220 call test221 call test023 call test024 call test026 call test027 call test028 call test527 call test0295 call test030 call test031 call test033 call test909 call test034 call test224 call test225 call test226 call test035 call test036 call test037 call test038 call test040 call test041 call test042 call test043 call test044 call test045 call test046 call test047 call test0481 call test0482 call test0483 call test049 call test050 call test052 call test053 call test054 call test056 call test057 call test059 call test060 call test061 call test062 call test063 call test0645 call test065 call test066 call test067 call test069 call test070 call test072 call test073 call test074 call test075 call test620 call test621 call test077 call test078 call test079 call test0795 call test0796 call test456 call test457 call test080 call test081 call test083 call test085 call test086 call test087 call test088 call test089 call test090 call test092 call test093 call test095 call test096 call test098 call test099 call test100 call test101 call test102 call test104 call test105 call test106 call test107 call test108 call test520 call test521 call test109 call test110 call test112 call test113 call test115 call test116 call test118 call test119 call test120 call test121 call test122 call test1225 call test123 call test124 call test125 call test126 call test209 call test211 call test127 call test128 call test380 call test381 call test304 call test305 call test204 call test205 call test129 call test130 call test131 call test133 call test134 call test135 call test137 call test138 call test139 call test140 call test142 call test143 call test144 call test145 call test146 call test148 call test149 call test151 call test152 call test153 call test154 call test155 write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PROB_PRB' write ( *, '(a)' ) ' Normal end of execution.' stop end subroutine test201 ! !******************************************************************************* ! !! TEST201 tests ANGLIT_CDF. !! TEST201 tests ANGLIT_CDF_INV. !! TEST201 tests ANGLIT_PDF. ! implicit none ! real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST201' write ( *, '(a)' ) ' For the Anglit PDF:' write ( *, '(a)' ) ' ANGLIT_CDF evaluates the CDF;' write ( *, '(a)' ) ' ANGLIT_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' ANGLIT_PDF evaluates the PDF;' x = 0.50E+00 call anglit_pdf ( x, pdf ) call anglit_cdf ( x, cdf ) call anglit_cdf_inv ( cdf, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test202 ! !******************************************************************************* ! !! TEST202 tests ANGLIT_MEAN; !! TEST202 tests ANGLIT_SAMPLE; !! TEST202 tests ANGLIT_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST202' write ( *, '(a)' ) ' For the Anglit PDF:' write ( *, '(a)' ) ' ANGLIT_MEAN computes the mean;' write ( *, '(a)' ) ' ANGLIT_SAMPLE samples;' write ( *, '(a)' ) ' ANGLIT_VARIANCE computes the 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, nsample call anglit_sample ( x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test001 ! !******************************************************************************* ! !! TEST001 tests ARCSIN_CDF. !! TEST001 tests ARCSIN_CDF_INV. !! TEST001 tests ARCSIN_PDF. ! implicit none ! real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST001' write ( *, '(a)' ) ' For the Arcsin PDF:' write ( *, '(a)' ) ' ARCSIN_CDF evaluates the CDF;' write ( *, '(a)' ) ' ARCSIN_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' ARCSIN_PDF evaluates the PDF;' x = 0.50E+00 call arcsin_pdf ( x, pdf ) call arcsin_cdf ( x, cdf ) call arcsin_cdf_inv ( cdf, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test003 ! !******************************************************************************* ! !! TEST003 tests ARCSIN_MEAN; !! TEST003 tests ARCSIN_SAMPLE; !! TEST003 tests ARCSIN_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST003' write ( *, '(a)' ) ' For the Arcsin PDF:' write ( *, '(a)' ) ' ARCSIN_MEAN computes the mean;' write ( *, '(a)' ) ' ARCSIN_SAMPLE samples;' write ( *, '(a)' ) ' ARCSIN_VARIANCE computes the variance.' call arcsin_mean ( mean ) call arcsin_variance ( variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call arcsin_sample ( x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test004 ! !******************************************************************************* ! !! TEST004 tests BENFORD_PDF. ! implicit none ! integer n real pdf ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST004' write ( *, '(a)' ) ' For the Benford PDF:' write ( *, '(a)' ) ' BENFORD_PDF evaluates the PDF.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' N PDF(N)' write ( *, '(a)' ) ' ' do n = 1, 19 call benford_pdf ( n, pdf ) write ( *, '(i6,g14.6)' ) n, pdf end do return end subroutine test005 ! !******************************************************************************* ! !! TEST005 tests BERNOULLI_CDF. !! TEST005 tests BERNOULLI_CDF_INV. ! implicit none ! real a real cdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST005' write ( *, '(a)' ) ' For the Bernoulli PDF,' write ( *, '(a)' ) ' BERNOULLI_CDF evaluates the CDF;' write ( *, '(a)' ) ' BERNOULLI_CDF_INV inverts the CDF.' cdf = 0.5E+00 a = 0.75E+00 call bernoulli_check ( a ) call bernoulli_cdf_inv ( cdf, a, x ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' CDF_INV argument CDF = ', cdf write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,i6)' ) ' CDF_INV value X = ', x write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' (Expected answer is 0)' call bernoulli_cdf ( x, a, cdf ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' (Expected answer is 0.75)' return end subroutine test006 ! !******************************************************************************* ! !! TEST006 tests BERNOULLI_MEAN; !! TEST006 tests BERNOULLI_SAMPLE; !! TEST006 tests BERNOULLI_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a integer i integer imax integer imin real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST006' write ( *, '(a)' ) ' For the Bernoulli PDF:' write ( *, '(a)' ) ' BERNOULLI_MEAN computes the mean;' write ( *, '(a)' ) ' BERNOULLI_SAMPLE samples;' write ( *, '(a)' ) ' BERNOULLI_VARIANCE computes the variance.' a = 0.75E+00 call bernoulli_check ( a ) call bernoulli_mean ( a, mean ) call bernoulli_variance ( a, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call bernoulli_sample ( a, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test007 ! !******************************************************************************* ! !! TEST007 tests BERNOULLI_PDF. !! TEST007 tests BERNOULLI_CDF. ! implicit none ! real a real cdf real pdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST007' write ( *, '(a)' ) ' For the Bernoulli PDF:' write ( *, '(a)' ) ' BERNOULLI_PDF evaluates the PDF.' write ( *, '(a)' ) ' BERNOULLI_CDF evaluates the CDF.' x = 1 a = 0.75E+00 call bernoulli_check ( a ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' do x = 0, 1 call bernoulli_pdf ( x, a, pdf ) call bernoulli_cdf ( x, a, cdf ) write ( *, '(i6,2g14.6)' ) x, pdf, cdf end do return end subroutine test008 ! !******************************************************************************* ! !! TEST008 tests BETA; !! TEST008 tests GAMMA. ! implicit none ! real a real b real beta real beta1 real beta2 real gamma ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST008' write ( *, '(a)' ) ' BETA evaluates the Beta function;' write ( *, '(a)' ) ' GAMMA evaluates the Gamma function.' a = 2.2E+00 b = 3.7E+00 beta1 = beta ( a, b ) beta2 = gamma ( a ) * gamma ( b ) / gamma ( a + b ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' Argument A = ', a write ( *, '(a,g14.6)' ) ' Argument B = ', b write ( *, '(a,g14.6)' ) ' Beta(A,B) = ', beta1 write ( *, '(a)' ) ' (Expected value = 0.0454 )' write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' Gamma(A)*Gamma(B)/Gamma(A+B) = ', beta2 return end subroutine test009 ! !******************************************************************************* ! !! TEST009 tests BETA_CDF; !! TEST009 tests BETA_CDF_INV. !! TEST009 tests BETA_PDF; ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST009' write ( *, '(a)' ) ' For the Beta PDF:' write ( *, '(a)' ) ' BETA_CDF evaluates the CDF;' write ( *, '(a)' ) ' BETA_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' BETA_PDF evaluates the PDF;' x = 0.6E+00 a = 12.0E+00 b = 12.0E+00 call beta_check ( a, b ) call beta_pdf ( x, a, b, pdf ) call beta_cdf ( x, a, b, cdf ) call beta_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test010 ! !******************************************************************************* ! !! TEST010 tests BETA__INC. ! implicit none ! real a real b real beta_inc real fx real fx2 integer n real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST010:' 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 = 0 do call beta_inc_values ( n, a, b, x, fx ) if ( n == 0 ) then exit end if fx2 = beta_inc ( a, b, x ) write ( *, '(3f8.4,2g14.6)' ) a, b, x, fx, fx2 end do return end subroutine test011 ! !******************************************************************************* ! !! TEST011 tests BETA_MEAN; !! TEST011 tests BETA_SAMPLE; !! TEST011 tests BETA_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST011' write ( *, '(a)' ) ' For the Beta PDF:' write ( *, '(a)' ) ' BETA_MEAN computes the mean;' write ( *, '(a)' ) ' BETA_SAMPLE samples;' write ( *, '(a)' ) ' BETA_VARIANCE computes the variance.' a = 2.0E+00 b = 3.0E+00 call beta_check ( a, b ) call beta_mean ( a, b, mean ) call beta_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call beta_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test013 ! !******************************************************************************* ! !! TEST013 tests BETA_BINOMIAL_CDF. !! TEST013 tests BETA_BINOMIAL_CDF_INV. !! TEST013 tests BETA_BINOMIAL_PDF. ! implicit none ! real a real b integer c real cdf real pdf integer x integer x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST013' write ( *, '(a)' ) ' For the Beta Binomial PDF,' write ( *, '(a)' ) ' BETA_BINOMIAL_CDF evaluates the CDF;' write ( *, '(a)' ) ' BETA_BINOMIAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' BETA_BINOMIAL_PDF evaluates the PDF;' x = 2 a = 2.0E+00 b = 3.0E+00 c = 4 call beta_binomial_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i6)' ) ' PDF parameter C = ', c write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,i6)' ) ' CDF_INV value = ', x2 return end subroutine test014 ! !******************************************************************************* ! !! TEST014 tests BETA_BINOMIAL_MEAN; !! TEST014 tests BETA_BINOMIAL_SAMPLE; !! TEST014 tests BETA_BINOMIAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer c integer i integer imax integer imin real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST014' write ( *, '(a)' ) ' For the Beta Binomial PDF:' write ( *, '(a)' ) ' BETA_BINOMIAL_MEAN computes the mean;' write ( *, '(a)' ) ' BETA_BINOMIAL_SAMPLE samples;' write ( *, '(a)' ) ' BETA_BINOMIAL_VARIANCE computes the variance.' a = 2.0E+00 b = 3.0E+00 c = 4 call beta_binomial_check ( a, b, c ) call beta_binomial_mean ( a, b, c, mean ) call beta_binomial_variance ( a, b, c, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i6)' ) ' PDF parameter C = ', c write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call beta_binomial_sample ( a, b, c, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test015 ! !******************************************************************************* ! !! TEST015 tests BETA_BINOMIAL_CDF. !! TEST015 tests BETA_BINOMIAL_PDF. ! implicit none ! real a real b integer c real cdf real pdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST015' write ( *, '(a)' ) ' For the Beta Binomial PDF:' write ( *, '(a)' ) ' BETA_BINOMIAL_PDF evaluates the PDF;' write ( *, '(a)' ) ' BETA_BINOMIAL_CDF evaluates the CDF.' a = 2.0E+00 b = 3.0E+00 c = 4 call beta_binomial_check ( a, b, c ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i6)' ) ' PDF parameter C = ', c write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' do x = 0, c call beta_binomial_pdf ( x, a, b, c, pdf ) call beta_binomial_cdf ( x, a, b, c, cdf ) write ( *, '(i6,2g14.6)' ) x, pdf, cdf end do return end subroutine test016 ! !******************************************************************************* ! !! TEST016 tests BETA_PASCAL_CDF. !! TEST016 tests BETA_PASCAL_CDF_INV. !! TEST016 tests BETA_PASCAL_PDF. ! implicit none ! integer a real b real c real cdf real pdf integer x integer x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST016' write ( *, '(a)' ) ' For the Beta Pascal PDF:' write ( *, '(a)' ) ' BETA_PASCAL_CDF evaluates the CDF;' write ( *, '(a)' ) ' BETA_PASCAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' BETA_PASCAL_PDF evaluates the PDF;' a = 5 b = 3.0E+00 c = 4.0E+00 x = a + 2 call beta_pascal_check ( a, b, c ) call beta_pascal_pdf ( x, a, b, c, pdf ) call beta_pascal_cdf ( x, a, b, c, cdf ) call beta_pascal_cdf_inv ( cdf, a, b, c, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,i6)' ) ' 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 value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,i6)' ) ' CDF_INV value = ', x2 return end subroutine test017 ! !******************************************************************************* ! !! TEST017 tests BETA_PASCAL_MEAN; !! TEST017 tests BETA_PASCAL_SAMPLE; !! TEST017 tests BETA_PASCAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer a real b real c integer i integer imax integer imin real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST017' write ( *, '(a)' ) ' For the Beta Pascal PDF:' write ( *, '(a)' ) ' BETA_PASCAL_MEAN computes the mean;' write ( *, '(a)' ) ' BETA_PASCAL_SAMPLE samples;' write ( *, '(a)' ) ' BETA_PASCAL_VARIANCE computes the variance.' a = 5 b = 3.0E+00 c = 4.0E+00 call beta_pascal_check ( a, b, c ) call beta_pascal_mean ( a, b, c, mean ) call beta_pascal_variance ( a, b, c, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' 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 mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST017 - DEBUG - ' write ( *, '(a)' ) ' BETA_PASCAL_SAMPLE is still goofy!' return do i = 1, nsample call beta_pascal_sample ( a, b, c, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test018 ! !******************************************************************************* ! !! TEST018 tests BETA_PASCAL_CDF. !! TEST018 tests BETA_PASCAL_PDF. ! implicit none ! integer a real b real c real cdf real pdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST018' write ( *, '(a)' ) ' For the Beta Pascal PDF:' write ( *, '(a)' ) ' BETA_PASCAL_PDF evaluates the PDF;' write ( *, '(a)' ) ' BETA_PASCAL_CDF evaluates the CDF.' a = 5 b = 3.0E+00 c = 4.0E+00 call beta_pascal_check ( a, b, c ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF parameter C = ', c write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' do x = a, a + 10 call beta_pascal_pdf ( x, a, b, c, pdf ) call beta_pascal_cdf ( x, a, b, c, cdf ) write ( *, '(i6,2g14.6)' ) x, pdf, cdf end do return end subroutine test0185 ! !******************************************************************************* ! !! TEST0185 tests BINOMIAL_CDF. ! implicit none ! real a real b real betai real fx real fx2 integer n real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0185:' write ( *, '(a)' ) ' BINOMIAL_CDF evaluates the cumulative distribution' write ( *, '(a)' ) ' function for the discrete binomial probability' write ( *, '(a)' ) ' density function.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' A is the number of trials;' write ( *, '(a)' ) ' B is the probability of success on one trial;' write ( *, '(a)' ) ' X is the number of successes;' write ( *, '(a)' ) ' BINOMIAL_CDF is the probability of having up to X' write ( *, '(a)' ) ' successes.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' A B X Exact F BINOMIAL_CDF(A,B,X)' write ( *, '(a)' ) ' ' n = 0 do call binomial_cdf_values ( n, a, b, x, fx ) if ( n == 0 ) then exit end if call binomial_cdf ( x, a, b, fx2 ) write ( *, '(2f8.4,f8.4,2g14.6)' ) a, b, x, fx, fx2 end do return end subroutine test019 ! !******************************************************************************* ! !! TEST019 tests BINOMIAL_CDF; !! TEST019 tests BINOMIAL_CDF_INV. !! TEST019 tests BINOMIAL_PDF; ! implicit none ! integer a real b real cdf real pdf integer x integer x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST019' write ( *, '(a)' ) ' For the Binomial PDF:' write ( *, '(a)' ) ' BINOMIAL_CDF evaluates the CDF;' write ( *, '(a)' ) ' BINOMIAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' BINOMIAL_PDF evaluates the PDF;' x = 3 a = 5 b = 0.95E+00 call binomial_check ( a, b ) call binomial_pdf ( x, a, b, pdf ) call binomial_cdf ( x, a, b, cdf ) call binomial_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,i6)' ) ' CDF_INV value X = ', x2 return end subroutine test020 ! !******************************************************************************* ! !! TEST020 tests BINOMIAL_COEF; !! TEST020 tests BINOMIAL_COEF_LOG. ! implicit none ! integer cnk1 real cnk2_log real cnk2 integer k integer n ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST020' write ( *, '(a)' ) ' BINOMIAL_COEF evaluates binomial coefficients.' write ( *, '(a)' ) ' BINOMIAL_COEF_LOG evaluates the logarithm.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'N, K, C(N,K)' write ( *, '(a)' ) ' ' do n = 0, 4 do k = 0, n call binomial_coef ( n, k, cnk1 ) call binomial_coef_log ( n, k, cnk2_log ) cnk2 = exp ( cnk2_log ) write ( *, '(3i6,g14.6)' ) n, k, cnk1, cnk2 end do end do return end subroutine test021 ! !******************************************************************************* ! !! TEST021 tests BINOMIAL_MEAN; !! TEST021 tests BINOMIAL_SAMPLE; !! TEST021 tests BINOMIAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer a real b integer i integer imax integer imin real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST021' write ( *, '(a)' ) ' For the Binomial PDF:' write ( *, '(a)' ) ' BINOMIAL_MEAN computes the mean;' write ( *, '(a)' ) ' BINOMIAL_SAMPLE samples;' write ( *, '(a)' ) ' BINOMIAL_VARIANCE computes the variance.' a = 5 b = 0.30E+00 call binomial_check ( a, b ) call binomial_mean ( a, b, mean ) call binomial_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call binomial_sample ( a, b, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test022 ! !******************************************************************************* ! !! TEST022 tests BINOMIAL_CDF. !! TEST022 tests BINOMIAL_PDF. ! implicit none ! integer a real b real cdf real pdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST022' write ( *, '(a)' ) ' For the Binomial PDF:' write ( *, '(a)' ) ' BINOMIAL_PDF evaluates the PDF.' write ( *, '(a)' ) ' BINOMIAL_CDF evaluates the CDF.' a = 5 b = 0.95E+00 call binomial_check ( a, b ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' do x = -1, a + 1 call binomial_pdf ( x, a, b, pdf ) call binomial_cdf ( x, a, b, cdf ) write ( *, '(i6,2g14.6)' ) x, pdf, cdf end do return end subroutine test220 ! !******************************************************************************* ! !! TEST220 tests BRADFORD_CDF. !! TEST220 tests BRADFORD_CDF_INV. !! TEST220 tests BRADFORD_PDF. ! implicit none ! real a real b real c real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST220' write ( *, '(a)' ) ' For the Bradford PDF:' write ( *, '(a)' ) ' BRADFORD_CDF evaluates the CDF;' write ( *, '(a)' ) ' BRADFORD_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' BRADFORD_PDF evaluates the PDF;' x = 1.25E+00 a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call bradford_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x 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 value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test221 ! !******************************************************************************* ! !! TEST221 tests BRADFORD_MEAN; !! TEST221 tests BRADFORD_SAMPLE; !! TEST221 tests BRADFORD_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b real c integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST221' write ( *, '(a)' ) ' For the Bradford PDF:' write ( *, '(a)' ) ' BRADFORD_MEAN computes the mean;' write ( *, '(a)' ) ' BRADFORD_SAMPLE samples;' write ( *, '(a)' ) ' BRADFORD_VARIANCE computes the variance.' a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call bradford_check ( a, b, c ) call bradford_mean ( a, b, c, mean ) call bradford_variance ( a, b, c, variance ) 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 mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call bradford_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test023 ! !******************************************************************************* ! !! TEST023 tests BURR_CDF. !! TEST023 tests BURR_CDF_INV. !! TEST023 tests BURR_PDF. ! implicit none ! real a real b real c real cdf real d real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST023' write ( *, '(a)' ) ' For the Burr PDF:' write ( *, '(a)' ) ' BURR_CDF evaluates the CDF;' write ( *, '(a)' ) ' BURR_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' BURR_PDF evaluates the PDF;' x = 3.0E+00 a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 d = 2.0E+00 call burr_check ( a, b, c, d ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x 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 write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test024 ! !******************************************************************************* ! !! TEST024 tests BURR_MEAN; !! TEST024 tests BURR_VARIANCE; !! TEST024 tests BURR_SAMPLE; ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b real c real d integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST024' write ( *, '(a)' ) ' For the Burr PDF:' write ( *, '(a)' ) ' BURR_MEAN computes the mean;' write ( *, '(a)' ) ' BURR_VARIANCE computes the variance;' write ( *, '(a)' ) ' BURR_SAMPLE samples;' a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 d = 2.0E+00 call burr_check ( a, b, c, d ) call burr_mean ( a, b, c, d, mean ) call burr_variance ( a, b, c, d, variance ) 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 write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call burr_sample ( a, b, c, d, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test026 ! !******************************************************************************* ! !! TEST026 tests CAUCHY_CDF. !! TEST026 tests CAUCHY_CDF_INV. !! TEST026 tests CAUCHY_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST026' write ( *, '(a)' ) ' For the Cauchy PDF:' write ( *, '(a)' ) ' CAUCHY_CDF evaluates the CDF;' write ( *, '(a)' ) ' CAUCHY_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' CAUCHY_PDF evaluates the PDF;' x = 0.75E+00 a = 2.0E+00 b = 3.0E+00 call cauchy_check ( a, b ) call cauchy_pdf ( x, a, b, pdf ) call cauchy_cdf ( x, a, b, cdf ) call cauchy_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test027 ! !******************************************************************************* ! !! TEST027 tests CAUCHY_MEAN; !! TEST027 tests CAUCHY_SAMPLE; !! TEST027 tests CAUCHY_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST027' write ( *, '(a)' ) ' For the Cauchy PDF:' write ( *, '(a)' ) ' CAUCHY_MEAN computes the mean;' write ( *, '(a)' ) ' CAUCHY_VARIANCE computes the variance;' write ( *, '(a)' ) ' CAUCHY_SAMPLE samples.' a = 2.0E+00 b = 3.0E+00 call cauchy_check ( a, b ) call cauchy_mean ( a, b, mean ) call cauchy_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF mean = ', variance do i = 1, nsample call cauchy_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test028 ! !******************************************************************************* ! !! TEST028 tests CHI_CDF. !! TEST028 tests CHI_CDF_INV. !! TEST028 tests CHI_PDF. ! implicit none ! real a real b real c real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST028' write ( *, '(a)' ) ' For the Chi PDF:' write ( *, '(a)' ) ' CHI_CDF evaluates the CDF.' write ( *, '(a)' ) ' CHI_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' CHI_PDF evaluates the PDF.' x = 2.0E+00 a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call chi_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x 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 value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value = ', x2 return end subroutine test527 ! !******************************************************************************* ! !! TEST527 tests CHI_MEAN; !! TEST527 tests CHI_SAMPLE; !! TEST527 tests CHI_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b real c integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST527' write ( *, '(a)' ) ' For the Chi PDF:' write ( *, '(a)' ) ' CHI_MEAN computes the mean;' write ( *, '(a)' ) ' CHI_VARIANCE computes the variance;' write ( *, '(a)' ) ' CHI_SAMPLE samples.' a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call chi_check ( a, b, c ) call chi_mean ( a, b, c, mean ) call chi_variance ( a, b, c, variance ) 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 mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call chi_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test0295 ! !******************************************************************************* ! !! TEST0295 tests CHISQUARE_CENTRAL_CDF. ! implicit none ! integer a real a2 real fx real fx2 integer n real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0295:' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_CDF evaluates the cumulative' write ( *, '(a)' ) ' distribution function for the chi-square central' write ( *, '(a)' ) ' probability density function.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' A X Exact F CHISQUARE_CENTRAL_CDF(A,X)' write ( *, '(a)' ) ' ' n = 0 do call chisquare_central_cdf_values ( n, a, x, fx ) if ( n == 0 ) then exit end if a2 = real ( a ) call chisquare_central_cdf ( x, a2, fx2 ) write ( *, '(i4,f8.4,2g14.6)' ) a, x, fx, fx2 end do return end subroutine test030 ! !******************************************************************************* ! !! TEST030 tests CHISQUARE_CENTRAL_CDF. !! TEST030 tests CHISQUARE_CENTRAL_CDF_INV. !! TEST030 tests CHISQUARE_CENTRAL_PDF. ! implicit none ! real a real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST030' write ( *, '(a)' ) ' For the central chi square PDF:' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_CDF evaluates the CDF;' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_PDF evaluates the PDF;' x = 6.0E+00 a = 4.0E+00 call chisquare_central_check ( a ) call chisquare_central_pdf ( x, a, pdf ) call chisquare_central_cdf ( x, a, cdf ) call chisquare_central_cdf_inv ( cdf, a, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test031 ! !******************************************************************************* ! !! TEST031 tests CHISQUARE_CENTRAL_MEAN; !! TEST031 tests CHISQUARE_CENTRAL_SAMPLE; !! TEST031 tests CHISQUARE_CENTRAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST031' write ( *, '(a)' ) ' For the central chi square PDF:' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_MEAN computes the mean;' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_SAMPLE samples;' write ( *, '(a)' ) ' CHISQUARE_CENTRAL_VARIANCE computes the variance.' a = 10.0E+00 call chisquare_central_check ( a ) call chisquare_central_mean ( a, mean ) call chisquare_central_variance ( a, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call chisquare_central_sample ( a, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test033 ! !******************************************************************************* ! !! TEST033 tests CHISQUARE_NONCENTRAL_MEAN; !! TEST033 tests CHISQUARE_NONCENTRAL_SAMPLE; !! TEST033 tests CHISQUARE_NONCENTRAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST033' write ( *, '(a)' ) ' For the noncentral chi square PDF:' write ( *, '(a)' ) ' CHISQUARE_NONCENTRAL_SAMPLE samples.' a = 3.0E+00 b = 2.0E+00 call chisquare_noncentral_check ( a, b ) call chisquare_noncentral_mean ( a, b, mean ) call chisquare_noncentral_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call chisquare_noncentral_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test909 ! !******************************************************************************* ! !! TEST909 tests CIRCLE_SAMPLE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b real c integer i integer imax integer imin integer j real mean(2) real variance(2) real x_table(nsample,2) real x1 real x2 real xmax(2) real xmin(2) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST909' write ( *, '(a)' ) ' CIRCLE_SAMPLE samples points in a circle.' a = 10.0E+00 b = 4.0E+00 c = 3.0E+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 do i = 1, nsample call circle_sample ( a, b, c, x1, x2 ) x_table(i,1) = x1 x_table(i,2) = x2 end do do j = 1, 2 call rvec_mean ( nsample, x_table(1,j), mean(j) ) call rvec_variance ( nsample, x_table(1,j), variance(j) ) call rvec_max ( nsample, x_table(1,j), imax, xmax(j) ) call rvec_min ( nsample, x_table(1,j), imin, xmin(j) ) end do write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test034 ! !******************************************************************************* ! !! TEST034 tests CIRCULAR_NORMAL_01_MEAN; !! TEST034 tests CIRCULAR_NORMAL_01_SAMPLE; !! TEST034 tests CIRCULAR_NORMAL_01_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin integer j real mean(2) real variance(2) real x(2) real x_table(nsample,2) real xmax(2) real xmin(2) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST034' write ( *, '(a)' ) ' For the Circular Normal 01 PDF:' write ( *, '(a)' ) ' CIRCULAR_NORMAL_01_MEAN computes the mean;' write ( *, '(a)' ) ' CIRCULAR_NORMAL_01_SAMPLE samples;' write ( *, '(a)' ) ' CIRCULAR_NORMAL_01_VARIANCE computes 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, nsample 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 rvec_mean ( nsample, x_table(1,j), mean(j) ) call rvec_variance ( nsample, x_table(1,j), variance(j) ) call rvec_max ( nsample, x_table(1,j), imax, xmax(j) ) call rvec_min ( nsample, x_table(1,j), imin, xmin(j) ) end do write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test224 ! !******************************************************************************* ! !! TEST224 tests COSINE_CDF. !! TEST224 tests COSINE_CDF_INV. !! TEST224 tests COSINE_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST224' write ( *, '(a)' ) ' For the Cosine PDF:' write ( *, '(a)' ) ' COSINE_CDF evaluates the CDF.' write ( *, '(a)' ) ' COSINE_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' COSINE_PDF evaluates the PDF.' x = 1.0E+00 a = 2.0E+00 b = 1.0E+00 call cosine_check ( a, b ) call cosine_cdf ( x, a, b, cdf ) call cosine_pdf ( x, a, b, pdf ) call cosine_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value ', x2 return end subroutine test225 ! !******************************************************************************* ! !! TEST225 tests COSINE_MEAN; !! TEST225 tests COSINE_SAMPLE; !! TEST225 tests COSINE_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST225' write ( *, '(a)' ) ' For the Cosine PDF:' write ( *, '(a)' ) ' COSINE_MEAN computes the mean;' write ( *, '(a)' ) ' COSINE_SAMPLE samples;' write ( *, '(a)' ) ' COSINE_VARIANCE computes the variance.' a = 2.0E+00 b = 1.0E+00 call cosine_check ( a, b ) call cosine_mean ( a, b, mean ) call cosine_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call cosine_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test226 ! !******************************************************************************* ! !! TEST226 tests COUPON_SIMULATE. ! implicit none ! integer, parameter :: n_trial = 10 integer, parameter :: max_type = 25 ! real average integer coupon(max_type) real expect integer i integer n_coupon integer n_type ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST226' write ( *, '(a)' ) ' COUPON_SIMULATE simulates the coupon ' write ( *, '(a)' ) ' collector''s problem.' write ( *, '(a)' ) ' ' do n_type = 5, 25, 5 write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Number of coupon types is ', n_type expect = real ( n_type ) * log ( real ( n_type ) ) write ( *, '(a,g14.6)' ) ' Expected wait is about ', expect write ( *, '(a)' ) ' ' average = 0.0E+00 do i = 1, n_trial call coupon_simulate ( n_type, coupon, n_coupon ) write ( *, '(2i5)' ) i, n_coupon average = average + real ( n_coupon ) end do average = average / real ( n_trial ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' Average wait was ', average end do return end subroutine test035 ! !******************************************************************************* ! !! TEST035 tests DERANGED_CDF; !! TEST035 tests DERANGED_CDF_INV. !! TEST035 tests DERANGED_PDF; ! implicit none ! integer a real cdf real pdf integer x integer x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST035' write ( *, '(a)' ) ' For the Deranged PDF:' write ( *, '(a)' ) ' DERANGED_CDF evaluates the CDF;' write ( *, '(a)' ) ' DERANGED_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' DERANGED_PDF evaluates the PDF;' x = 3 a = 7 call deranged_check ( a ) call deranged_pdf ( x, a, pdf ) call deranged_cdf ( x, a, cdf ) call deranged_cdf_inv ( cdf, a, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,i6)' ) ' CDF_INV value X = ', x2 return end subroutine test036 ! !******************************************************************************* ! !! TEST036 tests DERANGED_CDF. !! TEST036 tests DERANGED_PDF. ! implicit none ! integer a real cdf real pdf integer x ! a = 7 write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST036' write ( *, '(a)' ) ' For the Deranged PDF:' write ( *, '(a)' ) ' DERANGED_PDF evaluates the PDF.' write ( *, '(a)' ) ' DERANGED_CDF evaluates the CDF.' write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' call deranged_check ( a ) do x = 0, a call deranged_pdf ( x, a, pdf ) call deranged_cdf ( x, a, cdf ) write ( *, '(i6,2g14.6)' ) x, pdf, cdf end do return end subroutine test037 ! !******************************************************************************* ! !! TEST037 tests DERANGED_MEAN. !! TEST037 tests DERANGED_VARIANCE. !! TEST037 tests DERANGED_SAMPLE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer a integer i integer imax integer imin real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST037' write ( *, '(a)' ) ' For the Deranged PDF:' write ( *, '(a)' ) ' DERANGED_MEAN computes the mean.' write ( *, '(a)' ) ' DERANGED_VARIANCE computes the variance.' write ( *, '(a)' ) ' DERANGED_SAMPLE samples.' a = 7 call deranged_check ( a ) call deranged_mean ( a, mean ) call deranged_variance ( a, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call deranged_sample ( a, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test038 ! !******************************************************************************* ! !! TEST038 tests DIPOLE_CDF. !! TEST038 tests DIPOLE_CDF_INV. !! TEST038 tests DIPOLE_PDF. ! implicit none ! integer, parameter :: ntest = 3 ! real a real atest(ntest) real b real btest(ntest) real cdf integer itest real pi real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST038' write ( *, '(a)' ) ' For the Dipole PDF:' write ( *, '(a)' ) ' DIPOLE_CDF evaluates the CDF.' write ( *, '(a)' ) ' DIPOLE_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' DIPOLE_PDF evaluates the PDF.' atest(1) = 0.0E+00 btest(1) = 1.0E+00 atest(2) = pi() / 4.0E+00 btest(2) = 0.5E+00 atest(3) = pi() / 2.0E+00 btest(3) = 0.0E+00 do itest = 1, ntest x = 0.6E+00 a = atest(itest) b = btest(itest) call dipole_check ( a, b ) call dipole_pdf ( x, a, b, pdf ) call dipole_cdf ( x, a, b, cdf ) call dipole_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value = ', x2 end do return end subroutine test040 ! !******************************************************************************* ! !! TEST040 tests DIPOLE_SAMPLE. ! implicit none ! integer, parameter :: nsample = 1000 integer, parameter :: ntest = 3 ! real a real atest(ntest) real b real btest(ntest) integer i integer itest integer imax integer imin real mean real pi real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST040' write ( *, '(a)' ) ' For the Dipole PDF:' write ( *, '(a)' ) ' DIPOLE_SAMPLE samples.' atest(1) = 0.0E+00 btest(1) = 1.0E+00 atest(2) = pi () / 4.0E+00 btest(2) = 0.5E+00 atest(3) = pi() / 2.0E+00 btest(3) = 0.0E+00 do itest = 1, ntest a = atest(itest) b = btest(itest) call dipole_check ( a, b ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b do i = 1, nsample call dipole_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test041 ! !******************************************************************************* ! !! TEST041 tests DIRICHLET_MEAN; !! TEST041 tests DIRICHLET_SAMPLE. !! TEST041 tests DIRICHLET_VARIANCE. ! implicit none ! integer, parameter :: n = 3 integer, parameter :: nsample = 1000 ! real a(n) integer i integer imax(n) integer imin(n) integer j real mean(n) real m2(n,n) real variance(n) real x(n,nsample) real xmax(n) real xmin(n) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST041' write ( *, '(a)' ) ' For the Dirichlet PDF:' write ( *, '(a)' ) ' DIRICHLET_SAMPLE samples;' write ( *, '(a)' ) ' DIRICHLET_MEAN computes the mean;' write ( *, '(a)' ) ' DIRICHLET_VARIANCE computes the variance.' a(1) = 0.250E+00 a(2) = 0.500E+00 a(3) = 1.250E+00 call dirichlet_check ( n, a ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Number of components N = ', n write ( *, '(a)' ) ' PDF parameters A(I), I = 1 to N:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,g14.6)' ) i, a(i) end do call dirichlet_mean ( n, a, mean ) call dirichlet_variance ( n, a, variance ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' PDF mean, variance:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,2g14.6)' ) i, mean(i), variance(i) end do call dirichlet_moment2 ( n, a, m2 ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Second moments:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(3g14.6)' ) m2(i,1:n) end do do i = 1, nsample call dirichlet_sample ( n, a, x(1,i) ) end do call rrow_max ( n, n, nsample, x, imax, xmax ) call rrow_min ( n, n, nsample, x, imin, xmin ) call rrow_mean ( n, n, nsample, x, mean ) call rrow_variance ( n, n, nsample, x, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Observed Min, Max, Mean, Variance:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,4g14.6)' ) i, xmin(i), xmax(i), mean(i), variance(i) end do return end subroutine test042 ! !******************************************************************************* ! !! TEST042 tests DIRICHLET_PDF. ! implicit none ! integer, parameter :: n = 3 ! real a(n) integer i real pdf real x(n) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST042' write ( *, '(a)' ) ' For the Dirichlet PDF:' write ( *, '(a)' ) ' DIRICHLET_PDF evaluates the PDF.' x(1:3) = (/ 0.500E+00, 0.125E+00, 0.375E+00 /) a(1:3) = (/ 0.250E+00, 0.500E+00, 1.250E+00 /) call dirichlet_check ( n, a ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Number of components N = ', n write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' PDF arguments X(I), I = 1 to N:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,g14.6)' ) i, x(i) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' PDF parameters A(I), I = 1 to N:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,g14.6)' ) i, a(i) end do call dirichlet_pdf ( x, n, a, pdf ) write ( *, '(a,g14.6)' ) 'PDF value = ', pdf return end subroutine test043 ! !******************************************************************************* ! !! TEST043 tests DIRICHLET_MIX_MEAN; !! TEST043 tests DIRICHLET_MIX_SAMPLE. ! implicit none ! integer, parameter :: comp_num = 2 integer, parameter :: elem_num = 3 integer, parameter :: sample_num = 1000 integer, parameter :: elem_max = elem_num ! real a(elem_max,comp_num) integer comp integer comp_i real comp_weight(comp_num) integer elem_i integer imax(elem_num) integer imin(elem_num) real mean(elem_num) integer sample_i real variance(elem_num) real x(elem_num,sample_num) real xmax(elem_num) real xmin(elem_num) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST043' write ( *, '(a)' ) ' For the Dirichlet Mixture PDF:' write ( *, '(a)' ) ' DIRICHLET_MIX_SAMPLE samples;' write ( *, '(a)' ) ' DIRICHLET_MIX_MEAN computes the mean;' a(1,1) = 0.250E+00 a(2,1) = 0.500E+00 a(3,1) = 1.250E+00 a(1,2) = 2.000E+00 a(2,2) = 0.000E+00 a(3,2) = 2.000E+00 comp_weight(1) = 1.0E+00 comp_weight(2) = 2.0E+00 call dirichlet_mix_check ( comp_num, elem_max, elem_num, a, comp_weight ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Number of elements ELEM_NUM = ', elem_num write ( *, '(a,i6)' ) ' Number of components COMP_NUM = ', comp_num write ( *, '(a)' ) ' PDF parameters A(ELEM,COMP):' write ( *, '(a)' ) ' ' do elem_i = 1, elem_num write ( *, '(2g14.6)' ) a(elem_i,1:comp_num) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Component weights:' write ( *, '(a)' ) ' ' do comp_i = 1, comp_num write ( *, '(i6,g14.6)' ) comp_i, comp_weight(comp_i) end do call dirichlet_mix_mean ( comp_num, elem_max, elem_num, a, comp_weight, mean ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' PDF mean:' write ( *, '(a)' ) ' ' do elem_i = 1, elem_num write ( *, '(i6,2g14.6)' ) elem_i, mean(elem_i) end do do sample_i = 1, sample_num call dirichlet_mix_sample ( comp_num, elem_max, elem_num, a, & comp_weight, comp, x(1,sample_i) ) end do call rrow_max ( elem_num, elem_num, sample_num, x, imax, xmax ) call rrow_min ( elem_num, elem_num, sample_num, x, imin, xmin ) call rrow_mean ( elem_num, elem_num, sample_num, x, mean ) call rrow_variance ( elem_num, elem_num, sample_num, x, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', sample_num write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Observed Min, Max, Mean, Variance:' write ( *, '(a)' ) ' ' do elem_i = 1, elem_num write ( *, '(i6,4g14.6)' ) elem_i, xmin(elem_i), xmax(elem_i), & mean(elem_i), variance(elem_i) end do return end subroutine test044 ! !******************************************************************************* ! !! TEST044 tests DIRICHLET_MIX_PDF. ! implicit none ! integer, parameter :: comp_num = 2 integer, parameter :: elem_num = 3 integer, parameter :: elem_max = elem_num ! real a(elem_max,comp_num) integer comp_i real comp_weight(comp_num) integer elem_i real pdf real x(elem_num) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST044' write ( *, '(a)' ) ' For the Dirichlet mixture PDF:' write ( *, '(a)' ) ' DIRICHLET_MIX_PDF evaluates the PDF.' x(1:3) = (/ 0.500E+00, 0.125E+00, 0.375E+00 /) a(1,1) = 0.250E+00 a(2,1) = 0.500E+00 a(3,1) = 1.250E+00 a(1,2) = 2.000E+00 a(2,2) = 0.000E+00 a(3,2) = 2.000E+00 comp_weight(1:2) = (/ 1.0E+00, 2.0E+00 /) call dirichlet_mix_check ( comp_num, elem_max, elem_num, a, comp_weight ) write ( *, '(a,i6)' ) ' Number of elements ELEM_NUM = ', elem_num write ( *, '(a,i6)' ) ' Number of components COMP_NUM = ', comp_num write ( *, '(a)' ) ' PDF parameters A(ELEM,COMP):' write ( *, '(a)' ) ' ' do elem_i = 1, elem_num write ( *, '(2g14.6)' ) a(elem_i,1:comp_num) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Component weights:' write ( *, '(a)' ) ' ' do comp_i = 1, comp_num write ( *, '(i6,g14.6)' ) comp_i, comp_weight(comp_i) end do call dirichlet_mix_pdf ( x, comp_num, elem_max, elem_num, a, comp_weight, & pdf ) write ( *, '(a,g14.6)' ) 'PDF value = ', pdf return end subroutine test045 ! !******************************************************************************* ! !! TEST045 tests BETA_PDF. !! TEST045 tests DIRICHLET_PDF. ! implicit none ! integer, parameter :: n = 2 ! real a real aval real avec(n) real b real bval integer i real pdf real x real xval real xvec(n) ! xval = 0.25E+00 aval = 2.50E+00 bval = 3.50E+00 write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST045' write ( *, '(a)' ) ' BETA_PDF evaluates the Beta PDF.' write ( *, '(a)' ) ' DIRICHLET_PDF evaluates the Dirichlet PDF.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' For N = 2, Dirichlet = Beta.' xvec(1) = xval xvec(2) = 1.0E+00 - xval avec(1:2) = (/ aval, bval /) call dirichlet_check ( n, avec ) write ( *, '(a,i6)' ) ' Number of components N = ', n write ( *, '(a)' ) ' PDF arguments X(I), I = 1 to N:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,g14.6)' ) i, xvec(i) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' PDF parameters A(I), I = 1 to N:' write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(i6,g14.6)' ) i, avec(i) end do call dirichlet_pdf ( xvec, n, avec, pdf ) write ( *, '(a,g14.6)' ) 'Dirichlet PDF value = ', pdf x = xval a = aval b = bval call beta_pdf ( x, a, b, pdf ) write ( *, '(a,g14.6)' ) 'Beta PDF value = ', pdf return end subroutine test046 ! !******************************************************************************* ! !! TEST046 tests DISCRETE_CDF. !! TEST046 tests DISCRETE_CDF_INV. !! TEST046 tests DISCRETE_PDF. ! implicit none ! integer, parameter :: a = 6 ! real b(a) real cdf integer j real pdf integer x integer x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST046' write ( *, '(a)' ) ' For the Discrete PDF:' write ( *, '(a)' ) ' DISCRETE_CDF evaluates the CDF;' write ( *, '(a)' ) ' DISCRETE_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' DISCRETE_PDF evaluates the PDF;' b(1:6) = (/ 1.0E+00, 2.0E+00, 6.0E+00, 2.0E+00, 4.0E+00, 1.0E+00 /) call discrete_check ( a, b ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a)' ) ' PDF parameters B:' do j = 1, a write ( *, '(i6,g14.6)' ) j, b(j) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF CDF CDF_INV(CDF)' write ( *, '(a)' ) ' ' do x = 0, 7 call discrete_pdf ( x, a, b, pdf ) call discrete_cdf ( x, a, b, cdf ) call discrete_cdf_inv ( cdf, a, b, x2 ) write ( *, '(i6,2g14.6,i6)' ) x, pdf, cdf, x2 end do return end subroutine test047 ! !******************************************************************************* ! !! TEST047 tests DISCRETE_MEAN; !! TEST047 tests DISCRETE_SAMPLE; !! TEST047 tests DISCRETE_VARIANCE. ! implicit none ! integer, parameter :: a = 6 integer, parameter :: nsample = 1000 ! real b(a) integer i integer imax integer imin integer j real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST047' write ( *, '(a)' ) ' For the Discrete PDF:' write ( *, '(a)' ) ' DISCRETE_MEAN computes the mean;' write ( *, '(a)' ) ' DISCRETE_SAMPLE samples;' write ( *, '(a)' ) ' DISCRETE_VARIANCE computes the variance.' b(1:6) = (/ 1.0E+00, 2.0E+00, 6.0E+00, 2.0E+00, 4.0E+00, 1.0E+00 /) call discrete_check ( a, b ) call discrete_mean ( a, b, mean ) call discrete_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a write ( *, '(a)' ) ' PDF parameters B:' do j = 1, a write ( *, '(i6,g14.6)' ) j, b(j) end do write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call discrete_sample ( a, b, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test0481 ! !******************************************************************************* ! !! TEST0481 tests EMPIRICAL_DISCRETE_CDF; !! TEST0481 tests EMPIRICAL_DISCRETE_CDF_INV. !! TEST0481 tests EMPIRICAL_DISCRETE_PDF; ! implicit none ! integer, parameter :: a = 6 ! real, save, dimension ( a ) :: b = (/ & 1.0E+00, 1.0E+00, 3.0E+00, 2.0E+00, 1.0E+00, 2.0E+00 /) real, save, dimension ( a ) :: c = (/ & 0.0E+00, 1.0E+00, 2.0E+00, 4.5E+00, 6.0E+00, 10.0E+00 /) real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0481' write ( *, '(a)' ) ' For the Empirical Discrete PDF:' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_CDF evaluates the CDF;' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_PDF evaluates the PDF;' x = 4.5E+00 call empirical_discrete_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,i6)' ) ' PDF parameter A = ', a call rvec_print ( a, b, ' PDF parameter B:' ) call rvec_print ( a, c, ' PDF parameter C:' ) write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X2 = ', x2 return end subroutine test0482 ! !******************************************************************************* ! !! TEST0482 tests EMPIRICAL_DISCRETE_MEAN; !! TEST0482 tests EMPIRICAL_DISCRETE_SAMPLE; !! TEST0482 tests EMPIRICAL_DISCRETE_VARIANCE. ! implicit none ! integer, parameter :: a = 6 integer, parameter :: nsample = 1000 ! real, save, dimension ( a ) :: b = (/ & 1.0E+00, 1.0E+00, 3.0E+00, 2.0E+00, 1.0E+00, 2.0E+00 /) real, save, dimension ( a ) :: c = (/ & 0.0E+00, 1.0E+00, 2.0E+00, 4.5E+00, 6.0E+00, 10.0E+00 /) integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0482' write ( *, '(a)' ) ' For the Empirical Discrete PDF:' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_MEAN computes the mean;' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_SAMPLE samples;' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_VARIANCE computes the variance.' call empirical_discrete_check ( a, b, c ) call empirical_discrete_mean ( a, b, c, mean ) call empirical_discrete_variance ( a, b, c, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a call rvec_print ( a, b, ' PDF parameter B:' ) call rvec_print ( a, c, ' PDF parameter C:' ) write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call empirical_discrete_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test0483 ! !******************************************************************************* ! !! TEST0483 tests EMPIRICAL_DISCRETE_CDF. !! TEST0483 tests EMPIRICAL_DISCRETE_PDF. ! implicit none ! integer, parameter :: a = 6 ! real, save, dimension ( a ) :: b = (/ & 1.0E+00, 1.0E+00, 3.0E+00, 2.0E+00, 1.0E+00, 2.0E+00 /) real, save, dimension ( a ) :: c = (/ & 0.0E+00, 1.0E+00, 2.0E+00, 4.5E+00, 6.0E+00, 10.0E+00 /) real cdf integer i real pdf real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0483' write ( *, '(a)' ) ' For the Empirical Discrete PDF.' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_PDF evaluates the PDF.' write ( *, '(a)' ) ' EMPIRICAL_DISCRETE_CDF evaluates the CDF.' call empirical_discrete_check ( a, b, c ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter A = ', a call rvec_print ( a, b, ' PDF parameter B:' ) call rvec_print ( a, c, ' PDF parameter C:' ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' do i = -2, 12 x = real ( i ) call empirical_discrete_pdf ( x, a, b, c, pdf ) call empirical_discrete_cdf ( x, a, b, c, cdf ) write ( *, '(f8.4,2g14.6)' ) x, pdf, cdf end do return end subroutine test049 ! !******************************************************************************* ! !! TEST049 tests ERLANG_CDF. !! TEST049 tests ERLANG_CDF_INV. !! TEST049 tests ERLANG_PDF. ! implicit none ! real a real b integer c real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST049' write ( *, '(a)' ) ' For the Erlang PDF:' write ( *, '(a)' ) ' ERLANG_CDF evaluates the CDF.' write ( *, '(a)' ) ' ERLANG_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' ERLANG_PDF evaluates the PDF.' x = 4.0E+00 a = 1.0E+00 b = 2.0E+00 c = 3 call erlang_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i6)' ) ' PDF parameter C = ', c write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV ', x2 return end subroutine test050 ! !******************************************************************************* ! !! TEST050 tests ERLANG_MEAN; !! TEST050 tests ERLANG_SAMPLE; !! TEST050 tests ERLANG_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer c integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST050' write ( *, '(a)' ) ' For the Erlang PDF:' write ( *, '(a)' ) ' ERLANG_MEAN computes the mean;' write ( *, '(a)' ) ' ERLANG_SAMPLE samples;' write ( *, '(a)' ) ' ERLANG_VARIANCE computes the variance.' a = 1.0E+00 b = 2.0E+00 c = 3 call erlang_check ( a, b, c ) call erlang_mean ( a, b, c, mean ) call erlang_variance ( a, b, c, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,i6)' ) ' PDF parameter C = ', c write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call erlang_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test052 ! !******************************************************************************* ! !! TEST052 tests ERROR_FUNCTION. ! implicit none ! real cdf real erfx real error_function real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST052' write ( *, '(a)' ) ' ERROR_FUNCTION evaluates ERF(X).' x = 1.0E+00 erfx = error_function ( x ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' ERF argument X = ', x write ( *, '(a,g14.6)' ) ' ERF value ', erfx write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' (Expected answer is 0.843)' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Test:' write ( *, '(a)' ) ' 0.5 * ( ERF(X/SQRT(2)) + 1 ) = Normal_CDF(X)' write ( *, '(a)' ) ' ' x = 1.0E+00 x2 = x / sqrt ( 2.0E+00 ) erfx = error_function ( x2 ) call normal_01_cdf ( x, cdf ) write ( *, '(a,g14.6)' ) & '0.5 * ( ERF(X/SQRT(2)) + 1 ) = ', 0.5E+00 * ( erfx + 1.0E+00 ) write ( *, '(a,g14.6)' ) 'Normal_CDF(X) = ', cdf return end subroutine test053 ! !******************************************************************************* ! !! TEST053 tests EXPONENTIAL_01_CDF; !! TEST053 tests EXPONENTIAL_01_CDF_INV. !! TEST053 tests EXPONENTIAL_01_PDF; ! implicit none ! real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST053' write ( *, '(a)' ) ' For the Exponential 01 PDF:' write ( *, '(a)' ) ' EXPONENTIAL_01_CDF evaluates the CDF.' write ( *, '(a)' ) ' EXPONENTIAL_01_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' EXPONENTIAL_01_PDF evaluates the PDF.' x = 0.5E+00 call exponential_01_pdf ( x, pdf ) call exponential_01_cdf ( x, cdf ) call exponential_01_cdf_inv ( cdf, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X ', x2 return end subroutine test054 ! !******************************************************************************* ! !! TEST054 tests EXPONENTIAL_01_MEAN; !! TEST054 tests EXPONENTIAL_01_SAMPLE; !! TEST054 tests EXPONENTIAL_01_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST054' write ( *, '(a)' ) ' For the Exponential 01_PDF:' write ( *, '(a)' ) ' EXPONENTIAL_01_MEAN computes the mean;' write ( *, '(a)' ) ' EXPONENTIAL_01_SAMPLE samples;' write ( *, '(a)' ) ' EXPONENTIAL_01_VARIANCE computes the 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, nsample call exponential_01_sample ( x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test056 ! !******************************************************************************* ! !! TEST056 tests EXPONENTIAL_CDF; !! TEST056 tests EXPONENTIAL_CDF_INV. !! TEST056 tests EXPONENTIAL_PDF; ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST056' write ( *, '(a)' ) ' For the Exponential CDF:' write ( *, '(a)' ) ' EXPONENTIAL_CDF evaluates the CDF.' write ( *, '(a)' ) ' EXPONENTIAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' EXPONENTIAL_PDF evaluates the PDF.' x = 2.0E+00 a = 1.0E+00 b = 2.0E+00 call exponential_check ( a, b ) call exponential_pdf ( x, a, b, pdf ) call exponential_cdf ( x, a, b, cdf ) call exponential_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X ', x2 return end subroutine test057 ! !******************************************************************************* ! !! TEST057 tests EXPONENTIAL_MEAN; !! TEST057 tests EXPONENTIAL_SAMPLE; !! TEST057 tests EXPONENTIAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST057' write ( *, '(a)' ) ' For the Exponential PDF:' write ( *, '(a)' ) ' EXPONENTIAL_MEAN computes the mean;' write ( *, '(a)' ) ' EXPONENTIAL_SAMPLE samples;' write ( *, '(a)' ) ' EXPONENTIAL_VARIANCE computes the variance.' a = 1.0E+00 b = 10.0E+00 call exponential_check ( a, b ) call exponential_mean ( a, b, mean ) call exponential_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call exponential_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test059 ! !******************************************************************************* ! !! TEST059 tests EXTREME_CDF. !! TEST059 tests EXTREME_CDF_INV. !! TEST059 tests EXTREME_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST059' write ( *, '(a)' ) ' For the Extreme CDF:' write ( *, '(a)' ) ' EXTREME_CDF evaluates the CDF;' write ( *, '(a)' ) ' EXTREME_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' EXTREME_PDF evaluates the PDF;' x = 1.9E+00 a = 2.0E+00 b = 3.0E+00 call extreme_check ( a, b ) call extreme_pdf ( x, a, b, pdf ) call extreme_cdf ( x, a, b, cdf ) call extreme_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test060 ! !******************************************************************************* ! !! TEST060 tests EXTREME_MEAN; !! TEST060 tests EXTREME_SAMPLE; !! TEST060 tests EXTREME_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST060' write ( *, '(a)' ) ' For the Extreme PDF:' write ( *, '(a)' ) ' EXTREME_MEAN computes the mean;' write ( *, '(a)' ) ' EXTREME_SAMPLE samples;' write ( *, '(a)' ) ' EXTREME_VARIANCE computes the variance.' a = 2.0E+00 b = 3.0E+00 call extreme_check ( a, b ) call extreme_mean ( a, b, mean ) call extreme_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call extreme_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test061 ! !******************************************************************************* ! !! TEST061 tests F_CENTRAL_CDF. ! implicit none ! integer a integer b real fx real fx2 integer n real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST061:' write ( *, '(a)' ) ' F_CENTRAL_CDF evaluates the F central CDF.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) & ' A B X Exact F F_CENTRAL_CDF(A,B,X)' write ( *, '(a)' ) ' ' n = 0 do call f_central_cdf_values ( n, a, b, x, fx ) if ( n == 0 ) then exit end if call f_central_cdf ( x, a, b, fx2 ) write ( *, '(2i8,f8.4,2g14.6)' ) a, b, x, fx, fx2 end do return end subroutine test062 ! !******************************************************************************* ! !! TEST062 tests F_CENTRAL_CDF. !! TEST062 tests F_CENTRAL_PDF. ! implicit none ! real cdf integer m integer n real pdf real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST062' write ( *, '(a)' ) ' For the central F PDF:' write ( *, '(a)' ) ' F_CENTRAL_CDF evaluates the CDF.' write ( *, '(a)' ) ' F_CENTRAL_PDF evaluates the PDF.' x = 648.0E+00 m = 1 n = 1 call f_central_pdf ( x, m, n, pdf ) call f_central_cdf ( x, m, n, cdf ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,i6)' ) ' PDF parameter M = ', m write ( *, '(a,i6)' ) ' PDF parameter N = ', n write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf return end subroutine test063 ! !******************************************************************************* ! !! TEST063 tests F_CENTRAL_MEAN; !! TEST063 tests F_CENTRAL_SAMPLE; !! TEST063 tests F_CENTRAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin integer m real mean integer n real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST063' write ( *, '(a)' ) ' For the central F PDF:' write ( *, '(a)' ) ' F_CENTRAL_MEAN computes the mean;' write ( *, '(a)' ) ' F_CENTRAL_SAMPLE samples;' write ( *, '(a)' ) ' F_CENTRAL_VARIANCE computes the varianc.' m = 8 n = 6 call f_central_mean ( m, n, mean ) call f_central_variance ( m, n, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter M = ', m write ( *, '(a,i6)' ) ' PDF parameter N = ', n write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call f_central_sample ( m, n, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test0645 ! !******************************************************************************* ! !! TEST0645 tests FACTORIAL_LOG; !! TEST0645 tests GAMMA_LOG_INT; ! implicit none ! real f real factorial_log real g real gamma_log_int integer i real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0645' write ( *, '(a)' ) & ' FACTORIAL_LOG evaluates the log of the factorial function;' write ( *, '(a)' ) ' GAMMA_LOG_INT evaluates the log for integer argument.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'I, GAMMA_LOG_INT(I+1) FACTORIAL_LOG(I)' write ( *, '(a)' ) ' ' do i = 1, 20 g = gamma_log_int ( i+1 ) f = factorial_log ( i ) write ( *, '(i6,2g14.6)' ) i, g, f end do return end subroutine test065 ! !******************************************************************************* ! !! TEST065 tests FACTORIAL_STIRLING; !! TEST065 tests I_FACTORIAL; !! TEST065 tests R_FACTORIAL. ! implicit none ! integer i_factorial real factorial_stirling integer i real r_factorial real value ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST065' write ( *, '(a)' ) ' FACTORIAL_STIRLING computes Stirling''s' write ( *, '(a)' ) ' approximate factorial function;' write ( *, '(a)' ) ' I_FACTORIAL evaluates the factorial function;' write ( *, '(a)' ) ' R_FACTORIAL evaluates the factorial function.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' N Stirling N!' write ( *, '(a)' ) ' ' do i = 0, 10 value = factorial_stirling ( i ) write ( *, '(i6,g14.6,i20)' ) i, value, i_factorial ( i ) end do write ( *, '(a)' ) ' ' do i = 10, 20 value = factorial_stirling ( i ) write ( *, '(i6,2g14.6)' ) i, value, r_factorial ( i ) end do return end subroutine test066 ! !******************************************************************************* ! !! TEST066 tests FISK_CDF. !! TEST066 tests FISK_CDF_INV. !! TEST066 tests FISK_PDF. ! implicit none ! real a real b real c real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST066' write ( *, '(a)' ) ' For the Fisk PDF:' write ( *, '(a)' ) ' FISK_CDF evaluates the CDF;' write ( *, '(a)' ) ' FISK_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' FISK_PDF evaluates the PDF;' x = 1.9E+00 a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call fisk_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x 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 value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test067 ! !******************************************************************************* ! !! TEST067 tests FISK_MEAN; !! TEST067 tests FISK_SAMPLE; !! TEST067 tests FISK_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b real c integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST067' write ( *, '(a)' ) ' For the Fisk PDF:' write ( *, '(a)' ) ' FISK_MEAN computes the mean;' write ( *, '(a)' ) ' FISK_SAMPLE samples;' write ( *, '(a)' ) ' FISK_VARIANCE computes the variance.' a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call fisk_check ( a, b, c ) call fisk_mean ( a, b, c, mean ) call fisk_variance ( a, b, c, variance ) 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 mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call fisk_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test069 ! !******************************************************************************* ! !! TEST069 tests FOLDED_NORMAL_CDF. !! TEST069 tests FOLDED_NORMAL_CDF_INV. !! TEST069 tests FOLDED_NORMAL_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST069' write ( *, '(a)' ) ' For the Folded Normal PDF:' write ( *, '(a)' ) ' FOLDED_NORMAL_CDF evaluates the CDF.' write ( *, '(a)' ) ' FOLDED_NORMAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' FOLDED_NORMAL_PDF evaluates the PDF.' x = 0.5E+00 a = 2.0E+00 b = 3.0E+00 call folded_normal_check ( a, b ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test070 ! !******************************************************************************* ! !! TEST070 tests FOLDED_NORMAL_MEAN; !! TEST070 tests FOLDED_NORMAL_SAMPLE; !! TEST070 tests FOLDED_NORMAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST070' write ( *, '(a)' ) ' For the Folded Normal PDF:' write ( *, '(a)' ) ' FOLDED_NORMAL_MEAN computes the mean;' write ( *, '(a)' ) ' FOLDED_NORMAL_SAMPLE samples;' write ( *, '(a)' ) ' FOLDED_NORMAL_VARIANCE computes the variance.' a = 2.0E+00 b = 3.0E+00 call folded_normal_check ( a, b ) call folded_normal_mean ( a, b, mean ) call folded_normal_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call folded_normal_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test072 ! !******************************************************************************* ! !! TEST072 tests GAMMA; !! TEST072 tests GAMMA_LOG; !! TEST072 tests GAMMA_LOG_INT; !! TEST072 tests R_FACTORIAL. ! implicit none ! real g1 real g2 real g3 real g4 real gamma real gamma_log real gamma_log_int integer i real r_factorial real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST072' write ( *, '(a)' ) ' GAMMA evaluates the Gamma function;' write ( *, '(a)' ) ' GAMMA_LOG evaluates the log of the Gamma function;' write ( *, '(a)' ) ' GAMMA_LOG_INT evaluates the log for integer argument;' write ( *, '(a)' ) ' R_FACTORIAL evaluates the factorial function.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) & 'X, GAMMA(X), Exp(GAMMA_LOG(X)), Exp(GAMMA_LOG_INT(X)) ' // & 'R_FACTORIAL(X+1)' write ( *, '(a)' ) ' ' do i = 1, 10 x = real ( i ) g1 = gamma ( x ) g2 = exp ( gamma_log ( x ) ) g3 = exp ( gamma_log_int ( i ) ) g4 = r_factorial ( i - 1 ) write ( *, '(5g14.6)' ) x, g1, g2, g3, g4 end do return end subroutine test073 ! !******************************************************************************* ! !! TEST073 tests GAMMA_INC. ! implicit none ! real a real fx real fx2 real gamma_inc integer n real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST073:' write ( *, '(a)' ) ' GAMMA_INC evaluates the normalized incomplete Gamma' write ( *, '(a)' ) ' function P(A,X).' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' A X Exact F GAMMA_INC(A,X)' write ( *, '(a)' ) ' ' n = 0 do call gamma_inc_values ( n, a, x, fx ) if ( n == 0 ) then exit end if fx2 = gamma_inc ( a, x ) write ( *, '(2f8.4,2g14.6)' ) a, x, fx, fx2 end do return end subroutine test074 ! !******************************************************************************* ! !! TEST074 tests GAMMA_CDF. !! TEST074 tests GAMMA_PDF. ! implicit none ! real a real b real c real cdf integer i real pdf real x ! a = 1.0E+00 b = 1.5E+00 c = 3.0E+00 call gamma_check ( a, b, c ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST074' write ( *, '(a)' ) ' For the Gamma PDF:' write ( *, '(a)' ) ' GAMMA_CDF evaluates the CDF.' write ( *, '(a)' ) ' GAMMA_PDF evaluates the PDF.' 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)' ) ' ' write ( *, '(a)' ) ' X PDF CDF' write ( *, '(a)' ) ' ' do i = 0, 10 x = real ( i ) / 5.0E+00 call gamma_cdf ( x, a, b, c, cdf ) call gamma_pdf ( x, a, b, c, pdf ) write ( *, '(3g14.6)' ) x, pdf, cdf end do return end subroutine test075 ! !******************************************************************************* ! !! TEST075 tests GAMMA_MEAN; !! TEST075 tests GAMMA_SAMPLE; !! TEST075 tests GAMMA_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 integer, parameter :: test_num = 2 ! real a real a_test(test_num) real b real b_test(test_num) real c real c_test(test_num) integer i integer imax integer imin real mean integer test_i real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST075' write ( *, '(a)' ) ' For the Gamma PDF:' write ( *, '(a)' ) ' GAMMA_MEAN computes the mean;' write ( *, '(a)' ) ' GAMMA_SAMPLE samples;' write ( *, '(a)' ) ' GAMMA_VARIANCE computes the variance.' a_test(1) = 1.0E+00 a_test(2) = 2.0E+00 b_test(1) = 3.0E+00 b_test(2) = 0.5E+00 c_test(1) = 2.0E+00 c_test(2) = 0.5E+00 do test_i = 1, test_num a = a_test(test_i) b = b_test(test_i) c = c_test(test_i) call gamma_check ( a, b, c ) call gamma_mean ( a, b, c, mean ) call gamma_variance ( a, b, c, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' TEST NUMBER: ', test_i 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 mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call gamma_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test620 ! !******************************************************************************* ! !! TEST620 tests GENLOGISTIC_CDF. !! TEST620 tests GENLOGISTIC_CDF_INV. !! TEST620 tests GENLOGISTIC_PDF. ! implicit none ! real a real b real c real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST620' write ( *, '(a)' ) ' For the Generalized Logistic PDF:' write ( *, '(a)' ) ' GENLOGISTIC_PDF evaluates the PDF.' write ( *, '(a)' ) ' GENLOGISTIC_CDF evaluates the CDF;' write ( *, '(a)' ) ' GENLOGISTIC_CDF_INV inverts the CDF.' x = 1.25E+00 a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call genlogistic_check ( a, b, c ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x 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 value ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test621 ! !******************************************************************************* ! !! TEST621 tests GENLOGISTIC_MEAN; !! TEST621 tests GENLOGISTIC_SAMPLE; !! TEST621 tests GENLOGISTIC_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b real c integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST621' write ( *, '(a)' ) ' For the Generalized Logistic PDF:' write ( *, '(a)' ) ' GENLOGISTIC_MEAN computes the mean;' write ( *, '(a)' ) ' GENLOGISTIC_SAMPLE samples;' write ( *, '(a)' ) ' GENLOGISTIC_VARIANCE computes the variance.' a = 1.0E+00 b = 2.0E+00 c = 3.0E+00 call genlogistic_check ( a, b, c ) call genlogistic_mean ( a, b, c, mean ) call genlogistic_variance ( a, b, c, variance ) 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 mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call genlogistic_sample ( a, b, c, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test077 ! !******************************************************************************* ! !! TEST077 tests GEOMETRIC_CDF; !! TEST077 tests GEOMETRIC_CDF_INV. !! TEST077 tests GEOMETRIC_PDF; ! implicit none ! real a real cdf real pdf integer x integer x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST077' write ( *, '(a)' ) ' For the Geometric PDF:' write ( *, '(a)' ) ' GEOMETRIC_CDF evaluates the CDF;' write ( *, '(a)' ) ' GEOMETRIC_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' GEOMETRIC_PDF evaluates the PDF;' x = 5 a = 0.25E+00 call geometric_check ( a ) call geometric_pdf ( x, a, pdf ) call geometric_cdf ( x, a, cdf ) call geometric_cdf_inv ( cdf, a, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,i6)' ) ' CDF_INV value X = ', x2 return end subroutine test078 ! !******************************************************************************* ! !! TEST078 tests GEOMETRIC_MEAN; !! TEST078 tests GEOMETRIC_SAMPLE; !! TEST078 tests GEOMETRIC_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a integer i integer imax integer imin real mean real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST078' write ( *, '(a)' ) ' For the Geometric PDF:' write ( *, '(a)' ) ' GEOMETRIC_MEAN computes the mean;' write ( *, '(a)' ) ' GEOMETRIC_SAMPLE samples;' write ( *, '(a)' ) ' GEOMETRIC_VARIANCE computes the variance.' a = 0.25E+00 call geometric_check ( a ) call geometric_mean ( a, mean ) call geometric_variance ( a, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call geometric_sample ( a, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test079 ! !******************************************************************************* ! !! TEST079 tests GEOMETRIC_CDF. !! TEST079 tests GEOMETRIC_PDF. ! implicit none ! real a real cdf real pdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST079' write ( *, '(a)' ) ' For the Geometric PDF:' write ( *, '(a)' ) ' GEOMETRIC_PDF evaluates the PDF.' write ( *, '(a)' ) ' GEOMETRIC_CDF evaluates the CDF.' a = 0.25E+00 call geometric_check ( a ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X PDF(X) CDF(X)' write ( *, '(a)' ) ' ' do x = 0, 10 call geometric_pdf ( x, a, pdf ) call geometric_cdf ( x, a, cdf ) write ( *, '(i6,2g14.6)' ) x, pdf, cdf end do return end subroutine test0795 ! !******************************************************************************* ! !! TEST0795 tests GOMPERTZ_CDF. !! TEST0795 tests GOMPERTZ_CDF_INV. !! TEST0795 tests GOMPERTZ_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0795' write ( *, '(a)' ) ' For the Gompertz PDF:' write ( *, '(a)' ) ' GOMPERTZ_CDF evaluates the CDF;' write ( *, '(a)' ) ' GOMPERTZ_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' GOMPERTZ_PDF evaluates the PDF;' x = 0.6E+00 a = 2.0E+00 b = 3.0E+00 call gompertz_check ( a, b ) call gompertz_pdf ( x, a, b, pdf ) call gompertz_cdf ( x, a, b, cdf ) call gompertz_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test0796 ! !******************************************************************************* ! !! TEST0796 tests GOMPERTZ_SAMPLE; ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST0796' write ( *, '(a)' ) ' For the Gompertz PDF:' write ( *, '(a)' ) ' GOMPERTZ_SAMPLE samples;' a = 2.0E+00 b = 3.0E+00 call gompertz_check ( a, b ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b do i = 1, nsample call gompertz_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test456 ! !******************************************************************************* ! !! TEST456 tests GUMBEL_CDF; !! TEST456 tests GUMBEL_CDF_INV. !! TEST456 tests GUMBEL_PDF; ! implicit none ! real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST456' write ( *, '(a)' ) ' For the Gumbel PDF:' write ( *, '(a)' ) ' GUMBEL_CDF evaluates the CDF.' write ( *, '(a)' ) ' GUMBEL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' GUMBEL_PDF evaluates the PDF.' x = 0.5E+00 call gumbel_pdf ( x, pdf ) call gumbel_cdf ( x, cdf ) call gumbel_cdf_inv ( cdf, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X ', x2 return end subroutine test457 ! !******************************************************************************* ! !! TEST457 tests GUMBEL_MEAN; !! TEST457 tests GUMBEL_SAMPLE; !! TEST457 tests GUMBEL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST457' write ( *, '(a)' ) ' For the Gumbel PDF:' write ( *, '(a)' ) ' GUMBEL_MEAN computes the mean;' write ( *, '(a)' ) ' GUMBEL_SAMPLE samples;' write ( *, '(a)' ) ' GUMBEL_VARIANCE computes the 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, nsample call gumbel_sample ( x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test080 ! !******************************************************************************* ! !! TEST080 tests HALF_NORMAL_CDF; !! TEST080 tests HALF_NORMAL_CDF_INV. !! TEST080 tests HALF_NORMAL_PDF; ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST080' write ( *, '(a)' ) ' For the Half Normal PDF:' write ( *, '(a)' ) ' HALF_NORMAL_CDF evaluates the CDF.' write ( *, '(a)' ) ' HALF_NORMAL_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' HALF_NORMAL_PDF evaluates the PDF.' x = 0.5E+00 a = 0.0E+00 b = 2.0E+00 call half_normal_check ( a, b ) 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 ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value ', pdf write ( *, '(a,g14.6)' ) ' CDF value ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X ', x2 return end subroutine test081 ! !******************************************************************************* ! !! TEST081 tests HALF_NORMAL_MEAN; !! TEST081 tests HALF_NORMAL_SAMPLE; !! TEST081 tests HALF_NORMAL_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST081' write ( *, '(a)' ) ' For the Half Normal PDF:' write ( *, '(a)' ) ' HALF_NORMAL_MEAN computes the mean;' write ( *, '(a)' ) ' HALF_NORMAL_SAMPLE samples;' write ( *, '(a)' ) ' HALF_NORMAL_VARIANCE computes the variance.' a = 0.0E+00 b = 10.0E+00 call half_normal_check ( a, b ) call half_normal_mean ( a, b, mean ) call half_normal_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call half_normal_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test083 ! !******************************************************************************* ! !! TEST083 tests HYPERGEOMETRIC_CDF. !! TEST083 tests HYPERGEOMETRIC_PDF. ! implicit none ! real cdf integer l integer m integer n real pdf integer x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST083' write ( *, '(a)' ) ' For the Hypergeometric PDF:' write ( *, '(a)' ) ' HYPERGEOMETRIC_CDF evaluates the CDF.' write ( *, '(a)' ) ' HYPERGEOMETRIC_PDF evaluates the PDF.' x = 7 n = 100 m = 70 l = 1000 call hypergeometric_check ( n, m, l ) call hypergeometric_pdf ( x, n, m, l, pdf ) call hypergeometric_cdf ( x, n, m, l, cdf ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF argument X = ', x write ( *, '(a,i6)' ) ' Total number of balls = ', l write ( *, '(a,i6)' ) ' Number of white balls = ', m write ( *, '(a,i6)' ) ' Number of balls taken = ', n write ( *, '(a,g14.6)' ) ' PDF value = = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = = ', cdf return end subroutine test085 ! !******************************************************************************* ! !! TEST085 tests HYPERGEOMETRIC_MEAN; !! TEST085 tests HYPERGEOMETRIC_SAMPLE; !! TEST085 tests HYPERGEOMETRIC_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! integer i integer imax integer imin integer l integer m real mean integer n real variance integer x(nsample) integer xmax integer xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST085' write ( *, '(a)' ) ' For the Hypergeometric PDF:' write ( *, '(a)' ) ' HYPERGEOMETRIC_MEAN computes the mean;' write ( *, '(a)' ) ' HYPERGEOMETRIC_SAMPLE samples;' write ( *, '(a)' ) ' HYPERGEOMETRIC_VARIANCE computes the variance.' n = 100 m = 70 l = 1000 call hypergeometric_check ( n, m, l ) call hypergeometric_mean ( n, m, l, mean ) call hypergeometric_variance ( n, m, l, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' PDF parameter N = ', n write ( *, '(a,i6)' ) ' PDF parameter M = ', m write ( *, '(a,i6)' ) ' PDF parameter L = ', l write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'THIS CALL IS TAKING FOREVER!' return do i = 1, nsample call hypergeometric_sample ( n, m, l, x(i) ) end do call ivec_mean ( nsample, x, mean ) call ivec_variance ( nsample, x, variance ) call ivec_max ( nsample, x, imax, xmax ) call ivec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample write ( *, '(a,g14.6)' ) ' Sample mean = ', mean write ( *, '(a,g14.6)' ) ' Sample variance = ', variance write ( *, '(a,i6)' ) ' Sample maximum = ', xmax write ( *, '(a,i6)' ) ' Sample minimum = ', xmin return end subroutine test086 ! !******************************************************************************* ! !! TEST086 tests I_ROUNDUP. ! implicit none ! integer i integer i_roundup integer ival real rval ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST086' write ( *, '(a)' ) ' I_ROUNDUP rounds reals up.' do i = -6, 6 rval = real ( i ) / real ( 5.0E+00 ) ival = i_roundup ( rval ) write ( *, '(g14.6,i6)' ) rval, ival end do return end subroutine test087 ! !******************************************************************************* ! !! TEST087 tests INVERSE_GAUSSIAN_CDF. !! TEST087 tests INVERSE_GAUSSIAN_PDF. ! implicit none ! real a real b real cdf real pdf real x ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST087' write ( *, '(a)' ) ' For the Inverse Gaussian PDF:' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_CDF evaluates the CDF.' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_PDF evaluates the PDF.' x = 1.0E+00 a = 5.0E+00 b = 2.0E+00 call inverse_gaussian_check ( a, b ) call inverse_gaussian_pdf ( x, a, b, pdf ) call inverse_gaussian_cdf ( x, a, b, cdf ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf return end subroutine test088 ! !******************************************************************************* ! !! TEST088 tests INVERSE_GAUSSIAN_MEAN; !! TEST088 tests INVERSE_GAUSSIAN_SAMPLE; !! TEST088 tests INVERSE_GAUSSIAN_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST088' write ( *, '(a)' ) ' For the Inverse Gaussian PDF:' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_MEAN computes the mean;' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_SAMPLE samples;' write ( *, '(a)' ) ' INVERSE_GAUSSIAN_VARIANCE computes the variance.' a = 2.0E+00 b = 3.0E+00 call inverse_gaussian_check ( a, b ) call inverse_gaussian_mean ( a, b, mean ) call inverse_gaussian_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call inverse_gaussian_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test089 ! !******************************************************************************* ! !! TEST089 tests LAPLACE_CDF. !! TEST089 tests LAPLACE_CDF_INV. !! TEST089 tests LAPLACE_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST089' write ( *, '(a)' ) ' For the Laplace PDF:' write ( *, '(a)' ) ' LAPLACE_CDF evaluates the CDF;' write ( *, '(a)' ) ' LAPLACE_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' LAPLACE_PDF evaluates the PDF;' x = 3.0E+00 a = 1.0E+00 b = 2.0E+00 call laplace_check ( a, b ) call laplace_pdf ( x, a, b, pdf ) call laplace_cdf ( x, a, b, cdf ) call laplace_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test090 ! !******************************************************************************* ! !! TEST090 tests LAPLACE_MEAN; !! TEST090 tests LAPLACE_SAMPLE; !! TEST090 tests LAPLACE_VARIANCE. ! implicit none ! integer, parameter :: nsample = 1000 ! real a real b integer i integer imax integer imin real mean real variance real x(nsample) real xmax real xmin ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST090' write ( *, '(a)' ) ' For the Laplace PDF:' write ( *, '(a)' ) ' LAPLACE_MEAN computes the mean;' write ( *, '(a)' ) ' LAPLACE_SAMPLE samples;' write ( *, '(a)' ) ' LAPLACE_VARIANCE computes the variance.' a = 1.0E+00 b = 2.0E+00 call laplace_check ( a, b ) call laplace_mean ( a, b, mean ) call laplace_variance ( a, b, variance ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF mean = ', mean write ( *, '(a,g14.6)' ) ' PDF variance = ', variance do i = 1, nsample call laplace_sample ( a, b, x(i) ) end do call rvec_mean ( nsample, x, mean ) call rvec_variance ( nsample, x, variance ) call rvec_max ( nsample, x, imax, xmax ) call rvec_min ( nsample, x, imin, xmin ) write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' Sample size = ', nsample 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 test092 ! !******************************************************************************* ! !! TEST092 tests LOGISTIC_CDF. !! TEST092 tests LOGISTIC_CDF_INV. !! TEST092 tests LOGISTIC_PDF. ! implicit none ! real a real b real cdf real pdf real x real x2 ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST092' write ( *, '(a)' ) ' For the Logistic PDF:' write ( *, '(a)' ) ' LOGISTIC_CDF evaluates the CDF;' write ( *, '(a)' ) ' LOGISTIC_CDF_INV inverts the CDF.' write ( *, '(a)' ) ' LOGISTIC_PDF evaluates the PDF;' x = 3.0E+00 a = 1.0E+00 b = 2.0E+00 call logistic_check ( a, b ) call logistic_cdf ( x, a, b, cdf ) call logistic_pdf ( x, a, b, pdf ) call logistic_cdf_inv ( cdf, a, b, x2 ) write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' PDF argument X = ', x write ( *, '(a,g14.6)' ) ' PDF parameter A = ', a write ( *, '(a,g14.6)' ) ' PDF parameter B = ', b write ( *, '(a,g14.6)' ) ' PDF value = ', pdf write ( *, '(a,g14.6)' ) ' CDF value = ', cdf write ( *, '(a,g14.6)' ) ' CDF_INV value X = ', x2 return end subroutine test093 ! !***************************************************