Mercurial > octave-nkf

annotate libcruft/misc/d1mach.f @ 5103:e2ed74b9bfa0 after-gnuplot-split

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2004-12-28 02:43:01 by jwe]
author jwe
date Tue, 28 Dec 2004 02:43:01 +0000
parents 337a09dd1c06
children 32b15d5c3147
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2425
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
1 double precision function d1mach (i)
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
2 integer i
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
3 logical init
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
4 double precision dmach(5)
2621
337a09dd1c06 [project @ 1997-01-24 21:49:41 by jwe]
jwe
parents: 2425
diff changeset
5 save init, dmach
2425
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
6 data init /.false./
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
7 if (.not. init) then
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
8 call machar (dmach(1), dmach(2), dmach(3), dmach(4), dmach(5))
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
9 init = .true.
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
10 endif
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
11 if (i .lt. 1 .or. i .gt. 5) goto 999
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
12 d1mach = dmach(i)
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
13 return
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
14 999 write(*,1999) i
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
15 1999 format(' d1mach - i out of bounds', i10)
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
16 call xstopx (' ')
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
17 d1mach = 0
679068a18eee [project @ 1996-10-25 01:24:59 by jwe]
jwe
parents:
diff changeset
18 end