Impure wrapper function for f_dst_gamma_ppf_core
.
Handles optional arguments and invalid values for arguments.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=wp), | intent(in) | :: | p |
probability between 0.0 - 1.0 |
||
real(kind=wp), | intent(in), | optional | :: | alpha |
shape parameter |
|
real(kind=wp), | intent(in), | optional | :: | beta |
scale parameter |
|
real(kind=wp), | intent(in), | optional | :: | loc |
location parameter |
sample position
impure function f_dst_gamma_ppf(p, alpha, beta, loc) result(x) ! ==== Description !! Impure wrapper function for `f_dst_gamma_ppf_core`. !! Handles optional arguments and invalid values for arguments. ! ==== Declarations real(wp) , intent(in) :: p !! probability between 0.0 - 1.0 real(wp) , intent(in), optional :: alpha !! shape parameter real(wp) , intent(in), optional :: beta !! scale parameter real(wp) , intent(in), optional :: loc !! location parameter real(wp) :: alpha_w !! final value for alpha real(wp) :: beta_w !! final value for beta real(wp) :: loc_w !! final value for loc real(wp) :: x !! sample position ! ==== Instructions ! ---- handle input ! assume alpha = 1, overwrite if specified alpha_w = 1.0_wp if (present(alpha)) alpha_w = alpha ! assume beta = 1, overwrite if specified beta_w = 1.0_wp if (present(beta)) beta_w = beta ! assume loc = 0, overwrite if specified loc_w = 0.0_wp if (present(loc)) loc_w = loc ! check if alpha value is valid if (alpha_w .le. 0.0_wp) then ! write error message and assign sentinel value if invalid call s_err_print(fsml_error(1)) x = c_sentinel_r return endif ! check if beta value is valid if (beta_w .le. 0.0_wp) then ! write error message and assign sentinel value if invalid call s_err_print(fsml_error(1)) x = c_sentinel_r return endif ! check if p value is valid if (p .gt. 1.0_wp .or. p .lt. 0.0_wp) then ! write error message and assign sentinel value if invalid call s_err_print(fsml_error(1)) x = c_sentinel_r return endif ! ---- compute PPF ! call pure function to calculate x x = f_dst_gamma_ppf_core(p, alpha_w, beta_w, loc_w) ! issue warning in case of suspicious result if (x .eq. c_sentinel_r) call s_err_warn(fsml_warning(1)) end function f_dst_gamma_ppf