]>
Commit | Line | Data |
---|---|---|
a945c346 | 1 | ! Copyright (C) 2003-2024 Free Software Foundation, Inc. |
6de9cd9a DN |
2 | ! Contributed by Kejia Zhao <kejia_zh@yahoo.com.cn> |
3 | ! | |
01349049 | 4 | !This file is part of the GNU Fortran runtime library (libgfortran). |
6de9cd9a | 5 | ! |
748086b7 JJ |
6 | !Libgfortran is free software; you can redistribute it and/or |
7 | !modify it under the terms of the GNU General Public | |
6de9cd9a | 8 | !License as published by the Free Software Foundation; either |
748086b7 | 9 | !version 3 of the License, or (at your option) any later version. |
6de9cd9a | 10 | ! |
748086b7 | 11 | !Libgfortran is distributed in the hope that it will be useful, |
6de9cd9a DN |
12 | !but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
748086b7 | 14 | !GNU General Public License for more details. |
6de9cd9a | 15 | ! |
748086b7 JJ |
16 | !Under Section 7 of GPL version 3, you are granted additional |
17 | !permissions described in the GCC Runtime Library Exception, version | |
18 | !3.1, as published by the Free Software Foundation. | |
6de9cd9a | 19 | ! |
748086b7 JJ |
20 | !You should have received a copy of the GNU General Public License and |
21 | !a copy of the GCC Runtime Library Exception along with this program; | |
22 | !see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
23 | !<http://www.gnu.org/licenses/>. | |
6de9cd9a | 24 | |
01349049 | 25 | function _gfortran_selected_real_kind2008 (p, r, rdx) |
6de9cd9a | 26 | implicit none |
01349049 TB |
27 | integer, optional, intent (in) :: p, r, rdx |
28 | integer :: _gfortran_selected_real_kind2008 | |
29 | integer :: i, p2, r2, radix2 | |
30 | logical :: found_p, found_r, found_radix | |
6de9cd9a | 31 | ! Real kind_precision_range table |
6de9cd9a DN |
32 | type :: real_info |
33 | integer :: kind | |
34 | integer :: precision | |
35 | integer :: range | |
01349049 | 36 | integer :: radix |
6de9cd9a | 37 | end type real_info |
625be286 RH |
38 | |
39 | include "selected_real_kind.inc" | |
6de9cd9a | 40 | |
01349049 | 41 | _gfortran_selected_real_kind2008 = 0 |
6de9cd9a DN |
42 | p2 = 0 |
43 | r2 = 0 | |
01349049 | 44 | radix2 = 0 |
6de9cd9a DN |
45 | found_p = .false. |
46 | found_r = .false. | |
01349049 | 47 | found_radix = .false. |
6de9cd9a DN |
48 | |
49 | if (present (p)) p2 = p | |
50 | if (present (r)) r2 = r | |
01349049 | 51 | if (present (rdx)) radix2 = rdx |
6de9cd9a DN |
52 | |
53 | ! Assumes each type has a greater precision and range than previous one. | |
54 | ||
55 | do i = 1, c | |
56 | if (p2 <= real_infos (i) % precision) found_p = .true. | |
57 | if (r2 <= real_infos (i) % range) found_r = .true. | |
01349049 TB |
58 | if (radix2 <= real_infos (i) % radix) found_radix = .true. |
59 | ||
60 | if (p2 <= real_infos (i) % precision & | |
61 | .and. r2 <= real_infos (i) % range & | |
62 | .and. radix2 <= real_infos (i) % radix) then | |
63 | _gfortran_selected_real_kind2008 = real_infos (i) % kind | |
6de9cd9a DN |
64 | return |
65 | end if | |
66 | end do | |
67 | ||
01349049 TB |
68 | if (found_radix .and. found_r .and. .not. found_p) then |
69 | _gfortran_selected_real_kind2008 = -1 | |
70 | elseif (found_radix .and. found_p .and. .not. found_r) then | |
71 | _gfortran_selected_real_kind2008 = -2 | |
72 | elseif (found_radix .and. .not. found_p .and. .not. found_r) then | |
73 | _gfortran_selected_real_kind2008 = -3 | |
74 | elseif (found_radix) then | |
75 | _gfortran_selected_real_kind2008 = -4 | |
76 | else | |
77 | _gfortran_selected_real_kind2008 = -5 | |
78 | end if | |
79 | end function _gfortran_selected_real_kind2008 | |
80 | ||
81 | function _gfortran_selected_real_kind (p, r) | |
82 | implicit none | |
83 | integer, optional, intent (in) :: p, r | |
84 | integer :: _gfortran_selected_real_kind | |
85 | ||
86 | interface | |
87 | function _gfortran_selected_real_kind2008 (p, r, rdx) | |
88 | implicit none | |
89 | integer, optional, intent (in) :: p, r, rdx | |
90 | integer :: _gfortran_selected_real_kind2008 | |
91 | end function _gfortran_selected_real_kind2008 | |
92 | end interface | |
6de9cd9a | 93 | |
01349049 | 94 | _gfortran_selected_real_kind = _gfortran_selected_real_kind2008 (p, r) |
6de9cd9a | 95 | end function |