f_dst_llogistic_ppf Function

impure function f_dst_llogistic_ppf(p, alpha, beta, loc) result(x)

! ==== Description
!! Impure wrapper function for `f_dst_llogistic_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   !! distribution log-scale
  real(wp), intent(in), optional :: beta    !! distribution shape
  real(wp), intent(in), optional :: loc     !! distribution log-location
  real(wp)                       :: p_w     !! final value of p
  real(wp)                       :: loc_w   !! final value of loc
  real(wp)                       :: alpha_w !! final value of alpha
  real(wp)                       :: beta_w  !! final value of beta
  real(wp)                       :: x

! ==== Instructions

  ! assume alpha = 1, overwrite if specified
  alpha_w = 1.0_wp
  if (present(alpha)) alpha_w = alpha

  ! assume shape = 1, overwrite if specified
  beta_w = 1.0_wp
  if (present(beta)) beta_w = beta

  ! assume log-location = 0, overwrite if specified
  loc_w = 0.0_wp
  if (present(loc)) loc_w = loc

  ! check if alpha and shape values are valid
  if (alpha_w .le. 0.0_wp .or. beta_w .le. 0.0_wp) then
     call s_err_print(fsml_error(1))
     x = f_utl_assign_nan()
     return
  endif

  ! check if p value is valid
  if (p .le. 0.0_wp .or. p .ge. 1.0_wp) then
     call s_err_print(fsml_error(1))
     x = f_utl_assign_nan()
     return
  endif

! ---- compute PPF

  ! for stability, set very small (large) numbers to epsilon (1-epsilon)
  p_w = min(max(p, c_eps), 1.0_wp - c_eps)

  ! call pure function to calculate x
  x = f_dst_llogistic_ppf_core(p_w, alpha_w, beta_w, loc_w)

  ! issue warning in case of suspicious result
  if (f_utl_is_nan(x)) call s_err_warn(fsml_warning(1))

end function f_dst_llogistic_ppf