fortbite Public

Watch 0 Fork 0 Star 0
Fortran · 4402 bytes Raw Blame History
1 !> Precision management module for FORTBITE
2 !>
3 !> This module provides precision control using Fortran's selected_real_kind
4 !> system, allowing arbitrary precision arithmetic with user control.
5 module fortbite_precision_m
6 use iso_fortran_env, only: int32, int64, real32, real64, real128
7 implicit none
8 private
9
10 ! Public precision parameters
11 public :: wp, dp, qp, sp
12 public :: default_precision, max_precision
13 public :: set_default_precision, get_precision_kind
14 public :: precision_info_t, get_precision_info
15
16 ! Standard precision kinds
17 integer, parameter :: sp = real32 ! Single precision
18 integer, parameter :: dp = real64 ! Double precision
19 integer, parameter :: qp = real128 ! Quad precision (if available)
20
21 ! Default working precision (can be changed by user)
22 integer, parameter :: default_precision = dp
23 integer :: wp = default_precision ! Working precision
24
25 ! Maximum available precision on this system
26 integer, parameter :: max_precision = selected_real_kind(33, 4931)
27
28 !> Precision information type
29 type :: precision_info_t
30 integer :: kind_param !< Kind parameter
31 integer :: decimal_digits !< Decimal precision
32 integer :: exponent_range !< Exponent range
33 character(len=20) :: name !< Human-readable name
34 logical :: available !< Available on this system
35 end type precision_info_t
36
37 contains
38
39 !> Set the default working precision
40 subroutine set_default_precision(precision_digits)
41 integer, intent(in) :: precision_digits
42
43 integer :: new_kind
44
45 ! Get the appropriate kind for requested precision
46 new_kind = selected_real_kind(precision_digits)
47
48 if (new_kind > 0) then
49 wp = new_kind
50 else
51 write(*, '(A,I0,A)') 'Warning: Precision with ', precision_digits, &
52 ' digits not available. Using maximum available precision.'
53 wp = max_precision
54 end if
55 end subroutine set_default_precision
56
57 !> Get kind parameter for specified decimal precision
58 function get_precision_kind(decimal_digits, exponent_range) result(kind_param)
59 integer, intent(in) :: decimal_digits
60 integer, intent(in), optional :: exponent_range
61 integer :: kind_param
62
63 integer :: exp_range
64
65 exp_range = 37 ! Default exponent range
66 if (present(exponent_range)) exp_range = exponent_range
67
68 kind_param = selected_real_kind(decimal_digits, exp_range)
69
70 ! Fall back to maximum precision if requested precision unavailable
71 if (kind_param < 0) then
72 kind_param = max_precision
73 end if
74 end function get_precision_kind
75
76 !> Get information about a precision kind
77 function get_precision_info(kind_param) result(info)
78 integer, intent(in) :: kind_param
79 type(precision_info_t) :: info
80
81 info%kind_param = kind_param
82 select case (kind_param)
83 case (real32)
84 info%decimal_digits = precision(1.0_real32)
85 info%exponent_range = range(1.0_real32)
86 case (real64)
87 info%decimal_digits = precision(1.0_real64)
88 info%exponent_range = range(1.0_real64)
89 case (real128)
90 info%decimal_digits = precision(1.0_real128)
91 info%exponent_range = range(1.0_real128)
92 case default
93 ! For unknown kinds, try to get info using the kind parameter
94 info%decimal_digits = 15 ! reasonable default
95 info%exponent_range = 307 ! reasonable default
96 end select
97 info%available = (kind_param > 0)
98
99 ! Set human-readable name
100 select case (kind_param)
101 case (real32)
102 info%name = 'Single Precision'
103 case (real64)
104 info%name = 'Double Precision'
105 case (real128)
106 info%name = 'Quad Precision'
107 case default
108 if (kind_param == max_precision) then
109 info%name = 'Maximum Precision'
110 else
111 info%name = 'Custom Precision'
112 end if
113 end select
114 end function get_precision_info
115
116 end module fortbite_precision_m