Mercurial > octave-nkf

annotate libcruft/misc/r1mach.f @ 12312:b10ea6efdc58 release-3-4-x ss-3-3-91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
version is now 3.3.91
author John W. Eaton <jwe@octave.org>
date Mon, 31 Jan 2011 08:36:58 -0500
parents 32b15d5c3147
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
1 double precision function r1mach (i)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
2 integer i
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
3 logical init
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
4 double precision rmach(5)
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
5 double precision slamch
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
6 external slamch
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
7 save init, rmach
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
8 data init /.false./
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
9 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
10 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
11 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
12 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
13 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
14 rmach(5) = log10 (slamch ('b'))
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
15 init = .true.
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
16 endif
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
17 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
18 r1mach = rmach(i)
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
19 return
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
20 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
21 1999 format (' r1mach - i out of bounds', i10)
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
22 call xstopx (' ')
9372
32b15d5c3147 implement d1mach, i1mach, and r1mach using slamch and dlamch from lapack
John W. Eaton <jwe@octave.org>
parents: 7789
diff changeset
23 d1mach = 0
7789
82be108cc558 First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
diff changeset
24 end