Mercurial > hg > octave-nkf
diff libcruft/blas/dmach.f @ 2329:30c606bec7a8
[project @ 1996-07-19 01:29:05 by jwe]
Initial revision
author | jwe |
---|---|
date | Fri, 19 Jul 1996 01:29:55 +0000 |
parents | |
children |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/libcruft/blas/dmach.f @@ -0,0 +1,58 @@ + DOUBLE PRECISION FUNCTION DMACH(JOB) + INTEGER JOB +C +C SMACH COMPUTES MACHINE PARAMETERS OF FLOATING POINT +C ARITHMETIC FOR USE IN TESTING ONLY. NOT REQUIRED BY +C LINPACK PROPER. +C +C IF TROUBLE WITH AUTOMATIC COMPUTATION OF THESE QUANTITIES, +C THEY CAN BE SET BY DIRECT ASSIGNMENT STATEMENTS. +C ASSUME THE COMPUTER HAS +C +C B = BASE OF ARITHMETIC +C T = NUMBER OF BASE B DIGITS +C L = SMALLEST POSSIBLE EXPONENT +C U = LARGEST POSSIBLE EXPONENT +C +C THEN +C +C EPS = B**(1-T) +C TINY = 100.0*B**(-L+T) +C HUGE = 0.01*B**(U-T) +C +C DMACH SAME AS SMACH EXCEPT T, L, U APPLY TO +C DOUBLE PRECISION. +C +C CMACH SAME AS SMACH EXCEPT IF COMPLEX DIVISION +C IS DONE BY +C +C 1/(X+I*Y) = (X-I*Y)/(X**2+Y**2) +C +C THEN +C +C TINY = SQRT(TINY) +C HUGE = SQRT(HUGE) +C +C +C JOB IS 1, 2 OR 3 FOR EPSILON, TINY AND HUGE, RESPECTIVELY. +C + DOUBLE PRECISION EPS,TINY,HUGE,S +C + EPS = 1.0D0 + 10 EPS = EPS/2.0D0 + S = 1.0D0 + EPS + IF (S .GT. 1.0D0) GO TO 10 + EPS = 2.0D0*EPS +C + S = 1.0D0 + 20 TINY = S + S = S/16.0D0 + IF (S*1.0 .NE. 0.0D0) GO TO 20 + TINY = (TINY/EPS)*100.0 + HUGE = 1.0D0/TINY +C + IF (JOB .EQ. 1) DMACH = EPS + IF (JOB .EQ. 2) DMACH = TINY + IF (JOB .EQ. 3) DMACH = HUGE + RETURN + END