C #ENVRON V1B 30-MAY-73. C LAST UPDATE: C SUBROUTINE ENVRON ( SIG, BETA, T, RND ) INTEGER BETA, T, RND C C *PURPOSE. C TO FIND AND RETURN THE CHARACTERISTICS OF THE FLOATING C POINT ARITHMETIC SYSTEM ON THE CURRENT COMPUTER. SEE BELOW. C C *PARAMETERS: C C SIG - RETURNS THE REAL VALUE OF THE ESTIMATED MAXIMUM RELATIVE C ERROR IN FLOATING POINT NUMBERS ( SINGLE PRECISION) . C BETA- RETURNS THE INTEGER VALUE OF THE RADIX OF THE FLOATING C POINT SYSTEM. C T - RETURNS THE INTEGER VALUE OF THE NUMBER OF DIGITS IN THE C FLOATING POINT MANTISSA. THESE ARE DIGITS OF RADIX "BETA". C RND - RETURNS THE INTEGER VALUE: C 0 - IF FLOATING POINT ARITHMETIC CHOPS C 1 - IF FLOATING POINT ARITHMETIC ROUNDS RESULTS. C C INPUT PARAMETERS: C C OUTPUT PARAMETERS: C SIG, BETA, T, RND C C *METHOD. C THE METHOD IS TAKEN FROM AND EXPLAINED IN COMM A.C.M. C VOL 15(1972) P 949. BY M.A.MALCOLM. BASICALLY THE ROUTINE C FINDS THE LOWEST POWER OF 2 WHICH WHEN 1 IS ADDED DOES NOT C CHANGE, THEN DOES A FIDDLE TO FIND THE TRUE RADIX C BEING ONE OF 2, 4, 8, 10 OR 16. AND ROUNDING SYSTEM. FINALLY C IT COMPUTES POWERS OF THE RADIX TILL WHEN 1 IS ADDED THERE IS C NO CHANGE TO GET THE NUMBER OF DIGITS IN THE MANTISSA, AND C RETURNS "SIG" AS "BETA"**(-"T"). C C *ACCURACY. C C *RESTRICTIONS. C THE RADIX MUST BE ON OF 2, 4, 8, 10 OR 16. VERY FEW C SYSTEMS DO NOT SATISFY THIS. C C *ERROR CONDITIONS. C IF THE FLOATING POINT SYSTEM IS NON-STANDARD ( I.E. NOT C BASED ON A FIXED LENGTH MANTISSA OF FIXED RADIX) OR THE C RADIX IS NOT ONE OF 2, 4, 8, 10 OR 16 THE ROUTINE MAY DETECT THIS C AND RETURN "BETA" AS THE SMALLEST POWER OF 2 WHICH DOES NOT C CHANGE WHEN 1 IS ADDED AND "T" AS 1. C C *NON STANDARD ROUTINES CALLED. C C *TYPICAL TIMES. C C *ORIGIN. C FROM THE ALGORITHM GIVEN BY M.A.MALCOLM IN COMM A.C.M. C VOL 15 (1972) P 949. WITH ONE SLIGHT MOD BY M.R.MANNING. C C *COMMENTS. C C #END. C RND=0 A=2. 10 IF( (A+1.) - A .NE. 1.) GO TO 20 A=2.*A GO TO 10 C NOW BETA**T .LE. A .LT. BETA**(T+1) C C FOLLOWING IS RATHER SNEAKY 20 I=IFIX( (A+15.) -A) +1 GO TO ( 30,1,1,1,1,1,1,1,40,1,50,1,60,1,70,1,80,1,1,1,90),I C 30 BETA=16 GO TO 100 C 40 BETA=8 GO TO 100 C 50 BETA=10 GO TO 100 C 60 BETA=4 GO TO 100 C 70 BETA=2 GO TO 100 C 80 RND=1 I=IFIX( (A+5.) -A) +1 GO TO ( 82,1,1,1,84,1,86,1,88),I C 82 BETA=16 GO TO 100 C 84 BETA=4 GO TO 100 C 86 BETA=2 GO TO 100 C 88 BETA=8 GO TO 100 C 90 RND=1 BETA=10 C C NOW WE HAVE THE RADIX AND ROUNDING PHILOSOPHY C PROCEED TO COUNT THE DIGITS IN MANTISSA. C 100 T=0 A=1. 110 T=T+1 A=A*FLOAT(BETA) IF( (A+1.) - A .EQ. 1. ) GO TO 110 GO TO 200 C C THIS IS AN OOPS! - SOMETHING FUNNY ON THIS MACHINE. C 1 BETA=A T=1 C NOW SET SIG. 200 SIG= BETA**(-T) RETURN END