mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-11-18 20:12:26 +01:00
Fixed overflow in Boys
This commit is contained in:
parent
4269327046
commit
e7aa4c6ac7
@ -1746,7 +1746,7 @@
|
||||
"metadata": {
|
||||
"celltoolbar": "Raw Cell Format",
|
||||
"kernelspec": {
|
||||
"display_name": "OCaml 4.07.1",
|
||||
"display_name": "OCaml default",
|
||||
"language": "OCaml",
|
||||
"name": "ocaml-jupyter"
|
||||
},
|
||||
|
@ -209,29 +209,29 @@ let boys_function ~maxm t =
|
||||
let result =
|
||||
Array.init (maxm+1) (fun m -> 1. /. float_of_int (2*m+1))
|
||||
in
|
||||
(*
|
||||
assert (abs_float t > 1.e-10);
|
||||
*)
|
||||
if t <> 0. then
|
||||
begin
|
||||
let power_t_inv = (maxm+maxm+1) in
|
||||
try
|
||||
let fmax =
|
||||
let t_inv = sqrt (1. /. t) in
|
||||
let n = float_of_int maxm in
|
||||
let dm = 0.5 +. n in
|
||||
let f = (pow t_inv (maxm+maxm+1) ) in
|
||||
let f = (pow t_inv power_t_inv ) in
|
||||
match classify_float f with
|
||||
| FP_normal -> (incomplete_gamma dm t) *. 0.5 *. f
|
||||
| FP_zero
|
||||
| FP_subnormal -> 0.
|
||||
| _ -> invalid_arg "zero_m overflow"
|
||||
| _ ->
|
||||
Printf.eprintf "t=%e\n" t;
|
||||
Printf.eprintf "maxm=%d\n" maxm;
|
||||
raise Exit
|
||||
in
|
||||
let emt = exp (-. t) in
|
||||
result.(maxm) <- fmax;
|
||||
for n=maxm-1 downto 0 do
|
||||
result.(n) <- ( (t+.t) *. result.(n+1) +. emt) *. result.(n)
|
||||
done
|
||||
end;
|
||||
result
|
||||
done;
|
||||
result
|
||||
with Exit -> result
|
||||
end
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user