Mercurial > hg > octave-nkf
comparison 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 |
comparison
equal
deleted
inserted
replaced
| 2328:b44c3b2a5fce | 2329:30c606bec7a8 |
|---|---|
| 1 DOUBLE PRECISION FUNCTION DMACH(JOB) | |
| 2 INTEGER JOB | |
| 3 C | |
| 4 C SMACH COMPUTES MACHINE PARAMETERS OF FLOATING POINT | |
| 5 C ARITHMETIC FOR USE IN TESTING ONLY. NOT REQUIRED BY | |
| 6 C LINPACK PROPER. | |
| 7 C | |
| 8 C IF TROUBLE WITH AUTOMATIC COMPUTATION OF THESE QUANTITIES, | |
| 9 C THEY CAN BE SET BY DIRECT ASSIGNMENT STATEMENTS. | |
| 10 C ASSUME THE COMPUTER HAS | |
| 11 C | |
| 12 C B = BASE OF ARITHMETIC | |
| 13 C T = NUMBER OF BASE B DIGITS | |
| 14 C L = SMALLEST POSSIBLE EXPONENT | |
| 15 C U = LARGEST POSSIBLE EXPONENT | |
| 16 C | |
| 17 C THEN | |
| 18 C | |
| 19 C EPS = B**(1-T) | |
| 20 C TINY = 100.0*B**(-L+T) | |
| 21 C HUGE = 0.01*B**(U-T) | |
| 22 C | |
| 23 C DMACH SAME AS SMACH EXCEPT T, L, U APPLY TO | |
| 24 C DOUBLE PRECISION. | |
| 25 C | |
| 26 C CMACH SAME AS SMACH EXCEPT IF COMPLEX DIVISION | |
| 27 C IS DONE BY | |
| 28 C | |
| 29 C 1/(X+I*Y) = (X-I*Y)/(X**2+Y**2) | |
| 30 C | |
| 31 C THEN | |
| 32 C | |
| 33 C TINY = SQRT(TINY) | |
| 34 C HUGE = SQRT(HUGE) | |
| 35 C | |
| 36 C | |
| 37 C JOB IS 1, 2 OR 3 FOR EPSILON, TINY AND HUGE, RESPECTIVELY. | |
| 38 C | |
| 39 DOUBLE PRECISION EPS,TINY,HUGE,S | |
| 40 C | |
| 41 EPS = 1.0D0 | |
| 42 10 EPS = EPS/2.0D0 | |
| 43 S = 1.0D0 + EPS | |
| 44 IF (S .GT. 1.0D0) GO TO 10 | |
| 45 EPS = 2.0D0*EPS | |
| 46 C | |
| 47 S = 1.0D0 | |
| 48 20 TINY = S | |
| 49 S = S/16.0D0 | |
| 50 IF (S*1.0 .NE. 0.0D0) GO TO 20 | |
| 51 TINY = (TINY/EPS)*100.0 | |
| 52 HUGE = 1.0D0/TINY | |
| 53 C | |
| 54 IF (JOB .EQ. 1) DMACH = EPS | |
| 55 IF (JOB .EQ. 2) DMACH = TINY | |
| 56 IF (JOB .EQ. 3) DMACH = HUGE | |
| 57 RETURN | |
| 58 END |