Mercurial > octave

annotate liboctave/util/r1mach.f @ 32632:2e484f9f1f18 stable

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
maint: update Octave Project Developers copyright for the new year
author John W. Eaton <jwe@octave.org>
date Fri, 22 Dec 2023 12:08:17 -0500
parents 597f3ee61a48
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
32632
2e484f9f1f18 maint: update Octave Project Developers copyright for the new year
John W. Eaton <jwe@octave.org>
parents: 31706
diff changeset
1 c Copyright (C) 1993-2024 The Octave Project Developers
27918
b442ec6dda5c use centralized file for copyright info for individual contributors
John W. Eaton <jwe@octave.org>
parents: 26376
diff changeset
2 c
b442ec6dda5c use centralized file for copyright info for individual contributors
John W. Eaton <jwe@octave.org>
parents: 26376
diff changeset
3 c See the file COPYRIGHT.md in the top-level directory of this
27923
bd51beb6205e update formatting of copyright notices
John W. Eaton <jwe@octave.org>
parents: 27919
diff changeset
4 c distribution or <https://octave.org/copyright/>.
24537
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
5 c
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
6 c This file is part of Octave.
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
7 c
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
8 c Octave is free software: you can redistribute it and/or modify it
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
9 c under the terms of the GNU General Public License as published by
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
10 c the Free Software Foundation, either version 3 of the License, or
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
11 c (at your option) any later version.
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
12 c
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
13 c Octave is distributed in the hope that it will be useful, but
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
14 c WITHOUT ANY WARRANTY; without even the implied warranty of
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
15 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
16 c GNU General Public License for more details.
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
17 c
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
18 c You should have received a copy of the GNU General Public License
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
19 c along with Octave; see the file COPYING. If not, see
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
20 c <https://www.gnu.org/licenses/>.
11729ca6eb81 Add GPL license header to more Octave source files.
Rik <rik@octave.org>
parents: 23426
diff changeset
21 c
18565
c08776badd3d * r1mach.f: Fix cut and paste errors (bug #32120).
John W. Eaton <jwe@octave.org>
parents: 15271
diff changeset
22 real function r1mach (i)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
23 integer i
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
24 logical init
18565
c08776badd3d * r1mach.f: Fix cut and paste errors (bug #32120).
John W. Eaton <jwe@octave.org>
parents: 15271
diff changeset
25 real rmach(5)
c08776badd3d * r1mach.f: Fix cut and paste errors (bug #32120).
John W. Eaton <jwe@octave.org>
parents: 15271
diff changeset
26 real slamch
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
27 external slamch
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
28 save init, rmach
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
29 data init /.false./
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
30 if (.not. init) then
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
31 rmach(1) = slamch ('u')
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
32 rmach(2) = slamch ('o')
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
33 rmach(3) = slamch ('e')
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
34 rmach(4) = slamch ('p')
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
35 rmach(5) = log10 (slamch ('b'))
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
36 init = .true.
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
37 endif
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
38 if (i .lt. 1 .or. i .gt. 5) goto 999
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
39 r1mach = rmach(i)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
40 return
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
41 999 write (*, 1999) i
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
42 1999 format (' r1mach - i out of bounds', i10)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
43 call xstopx (' ')
18565
c08776badd3d * r1mach.f: Fix cut and paste errors (bug #32120).
John W. Eaton <jwe@octave.org>
parents: 15271
diff changeset
44 r1mach = 0
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
45 end