]>
Commit | Line | Data |
---|---|---|
748086b7 | 1 | ! Copyright 2003, 2004, 2009 Free Software Foundation, Inc. |
6de9cd9a DN |
2 | ! Contributed by Kejia Zhao <kejia_zh@yahoo.com.cn> |
3 | ! | |
748086b7 | 4 | !This file is part of the GNU Fortran 95 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 | |
e6472bce | 25 | function _gfortran_selected_real_kind (p, r) |
6de9cd9a DN |
26 | implicit none |
27 | integer, optional, intent (in) :: p, r | |
e6472bce | 28 | integer :: _gfortran_selected_real_kind |
6de9cd9a DN |
29 | integer :: i, p2, r2 |
30 | logical :: found_p, found_r | |
31 | ! Real kind_precision_range table | |
6de9cd9a DN |
32 | type :: real_info |
33 | integer :: kind | |
34 | integer :: precision | |
35 | integer :: range | |
36 | end type real_info | |
625be286 RH |
37 | |
38 | include "selected_real_kind.inc" | |
6de9cd9a | 39 | |
e6472bce | 40 | _gfortran_selected_real_kind = 0 |
6de9cd9a DN |
41 | p2 = 0 |
42 | r2 = 0 | |
43 | found_p = .false. | |
44 | found_r = .false. | |
45 | ||
46 | if (present (p)) p2 = p | |
47 | if (present (r)) r2 = r | |
48 | ||
49 | ! Assumes each type has a greater precision and range than previous one. | |
50 | ||
51 | do i = 1, c | |
52 | if (p2 <= real_infos (i) % precision) found_p = .true. | |
53 | if (r2 <= real_infos (i) % range) found_r = .true. | |
54 | if (found_p .and. found_r) then | |
e6472bce | 55 | _gfortran_selected_real_kind = real_infos (i) % kind |
6de9cd9a DN |
56 | return |
57 | end if | |
58 | end do | |
59 | ||
e6472bce FXC |
60 | if (.not. (found_p)) _gfortran_selected_real_kind = _gfortran_selected_real_kind - 1 |
61 | if (.not. (found_r)) _gfortran_selected_real_kind = _gfortran_selected_real_kind - 2 | |
6de9cd9a DN |
62 | |
63 | return | |
64 | end function |