Mercurial > octave-nkf

comparison libcruft/lapack/dlamch.f @ 7034:68db500cb558

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2007-10-16 18:54:19 by jwe]
author jwe
date Tue, 16 Oct 2007 18:54:23 +0000
parents f8b4692eb51c
children
comparison
equal deleted inserted replaced
7033:f0142f2afdc6 7034:68db500cb558
1 DOUBLE PRECISION FUNCTION DLAMCH( CMACH ) 1 DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
2 * 2 *
3 * -- LAPACK auxiliary routine (version 3.0) -- 3 * -- LAPACK auxiliary routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * Courant Institute, Argonne National Lab, and Rice University 5 * November 2006
6 * October 31, 1992
7 * 6 *
8 * .. Scalar Arguments .. 7 * .. Scalar Arguments ..
9 CHARACTER CMACH 8 CHARACTER CMACH
10 * .. 9 * ..
11 * 10 *
70 DATA FIRST / .TRUE. / 69 DATA FIRST / .TRUE. /
71 * .. 70 * ..
72 * .. Executable Statements .. 71 * .. Executable Statements ..
73 * 72 *
74 IF( FIRST ) THEN 73 IF( FIRST ) THEN
75 FIRST = .FALSE.
76 CALL DLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX ) 74 CALL DLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
77 BASE = BETA 75 BASE = BETA
78 T = IT 76 T = IT
79 IF( LRND ) THEN 77 IF( LRND ) THEN
80 RND = ONE 78 RND = ONE
118 ELSE IF( LSAME( CMACH, 'O' ) ) THEN 116 ELSE IF( LSAME( CMACH, 'O' ) ) THEN
119 RMACH = RMAX 117 RMACH = RMAX
120 END IF 118 END IF
121 * 119 *
122 DLAMCH = RMACH 120 DLAMCH = RMACH
121 FIRST = .FALSE.
123 RETURN 122 RETURN
124 * 123 *
125 * End of DLAMCH 124 * End of DLAMCH
126 * 125 *
127 END 126 END