home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPL60N11.ZIP / TESTPRGS.ZIP / DLOG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-28  |  21.9 KB  |  656 lines
  1. {$A+,B-,D-,E+,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  2.  
  3. (*
  4. C     PROGRAM TO TEST DLOG
  5. C
  6. C     DATA REQUIRED
  7. C
  8. C        NONE
  9. C
  10. C     SUBPROGRAMS REQUIRED FROM THIS PACKAGE
  11. C
  12. C        MACHAR - AN ENVIRONMENTAL INQUIRY PROGRAM PROVIDING
  13. C                 INFORMATION ON THE FLOATING-POINT ARITHMETIC
  14. C                 SYSTEM.  NOTE THAT THE CALL TO MACHAR CAN
  15. C                 BE DELETED PROVIDED THE FOLLOWING FOUR
  16. C                 PARAMETERS ARE ASSIGNED THE VALUES INDICATED
  17. C
  18. C                 IBETA - THE RADIX OF THE FLOATING-POINT SYSTEM
  19. C                 IT    - THE NUMBER OF BASE-IBETA DIGITS IN THE
  20. C                         SIGNIFICAND OF A FLOATING-POINT NUMBER
  21. C                 XMIN  - THE SMALLEST NON-VANISHING FLOATING-POINT
  22. C                         POWER OF THE RADIX
  23. C                 XMAX  - THE LARGEST FINITE FLOATING-POINT NO.
  24. C
  25. C        REN(K) - A FUNCTION SUBPROGRAM RETURNING RANDOM REAL
  26. C                 NUMBERS UNIFORMLY DISTRIBUTED OVER (0,1)
  27. C
  28. C
  29. C     STANDARD FORTRAN SUBPROGRAMS REQUIRED
  30. C
  31. C         DABS, DLOG, DLOG10, DMAX1, DFLOAT, DSIGN, DSQRT
  32. C
  33. C
  34. C     LATEST REVISION - DECEMBER 6, 1979
  35. C
  36. C     AUTHOR - W. J. CODY
  37. C              ARGONNE NATIONAL LABORATORY
  38. C
  39. C
  40. *)
  41.  
  42.  
  43.  
  44. FUNCTION REN (K: LONGINT): REAL;
  45.  
  46. (*
  47.       DOUBLE PRECISION FUNCTION REN(K)
  48. C
  49. C     RANDOM NUMBER GENERATOR - BASED ON ALGORITHM 266 BY PIKE AND
  50. C      HILL (MODIFIED BY HANSSON), COMMUNICATIONS OF THE ACM,
  51. C      VOL. 8, NO. 10, OCTOBER 1965.
  52. C
  53. C     THIS SUBPROGRAM IS INTENDED FOR USE ON COMPUTERS WITH
  54. C      FIXED POINT WORDLENGTH OF AT LEAST 29 BITS.  IT IS
  55. C      BEST IF THE FLOATING POINT SIGNIFICAND HAS AT MOST
  56. C      29 BITS.
  57. C
  58. *)
  59.  
  60. VAR   J: LONGINT;
  61. CONST IY: LONGINT = 100001;
  62.  
  63. BEGIN
  64.       J  := K;
  65.       IY := IY * 125;
  66.       IY := IY - (IY DIV 2796203) * 2796203;
  67.       REN:= 1.0 * (IY) / 2796203.0e0 * (1.0e0 + 1.0e-6 + 1.0e-12);
  68. END;
  69.  
  70.  
  71. FUNCTION LOG (X: REAL): REAL;
  72. BEGIN
  73.    LOG  := LN (X) * 0.43429448190325182765;
  74. END;
  75.  
  76.  
  77.  
  78. FUNCTION MAX1 (A, B:REAL): REAL;
  79. BEGIN
  80.    IF A > B THEN
  81.       MAX1 := A
  82.    ELSE
  83.       MAX1 := B;
  84. END;
  85.  
  86.  
  87.       PROCEDURE MACHAR(VAR IBETA,IT,IRND,NGRD,MACHEP,NEGEP,IEXP,MINEXP,
  88.                       MAXEXP: LONGINT; VAR EPS,EPSNEG,XMIN,XMAX: REAL);
  89. {
  90. C-----------------------------------------------------------------------
  91. C  This Fortran 77 subroutine is intended to determine the parameters
  92. C   of the floating-point arithmetic system specified below.  The
  93. C   determination of the first three uses an extension of an algorithm
  94. C   due to M. Malcolm, CACM 15 (1972), pp. 949-951, incorporating some,
  95. C   but not all, of the improvements suggested by M. Gentleman and S.
  96. C   Marovich, CACM 17 (1974), pp. 276-277.  An earlier version of this
  97. C   program was published in the book Software Manual for the
  98. C   Elementary Functions by W. J. Cody and W. Waite, Prentice-Hall,
  99. C   Englewood Cliffs, NJ, 1980.  The present version is documented in
  100. C   W. J. Cody, "MACHAR: A subroutine to dynamically determine machine
  101. C   parameters," TOMS 14, December, 1988.
  102. C
  103. C  The program as given here must be modified before compiling.  If
  104. C   a single (double) precision version is desired, change all
  105. C   occurrences of CS (CD) in columns 1 and 2 to blanks.
  106. C
  107. C  Parameter values reported are as follows:
  108. C
  109. C       IBETA   - the radix for the floating-point representation
  110. C       IT      - the number of base IBETA digits in the floating-point
  111. C                 significand
  112. C       IRND    - 0 if floating-point addition chops
  113. C                 1 if floating-point addition rounds, but not in the
  114. C                   IEEE style
  115. C                 2 if floating-point addition rounds in the IEEE style
  116. C                 3 if floating-point addition chops, and there is
  117. C                   partial underflow
  118. C                 4 if floating-point addition rounds, but not in the
  119. C                   IEEE style, and there is partial underflow
  120. C                 5 if floating-point addition rounds in the IEEE style,
  121. C                   and there is partial underflow
  122. C       NGRD    - the number of guard digits for multiplication with
  123. C                 truncating arithmetic.  It is
  124. C                 0 if floating-point arithmetic rounds, or if it
  125. C                   truncates and only  IT  base  IBETA digits
  126. C                   participate in the post-normalization shift of the
  127. C                   floating-point significand in multiplication;
  128. C                 1 if floating-point arithmetic truncates and more
  129. C                   than  IT  base  IBETA  digits participate in the
  130. C                   post-normalization shift of the floating-point
  131. C                   significand in multiplication.
  132. C       MACHEP  - the largest negative integer such that
  133. C                 1.0+FLOAT(IBETA)**MACHEP .NE. 1.0, except that
  134. C                 MACHEP is bounded below by  -(IT+3)
  135. C       NEGEPS  - the largest negative integer such that
  136. C                 1.0-FLOAT(IBETA)**NEGEPS .NE. 1.0, except that
  137. C                 NEGEPS is bounded below by  -(IT+3)
  138. C       IEXP    - the number of bits (decimal places if IBETA = 10)
  139. C                 reserved for the representation of the exponent
  140. C                 (including the bias or sign) of a floating-point
  141. C                 number
  142. C       MINEXP  - the largest in magnitude negative integer such that
  143. C                 FLOAT(IBETA)**MINEXP is positive and normalized
  144. C       MAXEXP  - the smallest positive power of  BETA  that overflows
  145. C       EPS     - the smallest positive floating-point number such
  146. C                 that  1.0+EPS .NE. 1.0. In particular, if either
  147. C                 IBETA = 2  or  IRND = 0, EPS = FLOAT(IBETA)**MACHEP.
  148. C                 Otherwise,  EPS = (FLOAT(IBETA)**MACHEP)/2
  149. C       EPSNEG  - A small positive floating-point number such that
  150. C                 1.0-EPSNEG .NE. 1.0. In particular, if IBETA = 2
  151. C                 or  IRND = 0, EPSNEG = FLOAT(IBETA)**NEGEPS.
  152. C                 Otherwise,  EPSNEG = (IBETA**NEGEPS)/2.  Because
  153. C                 NEGEPS is bounded below by -(IT+3), EPSNEG may not
  154. C                 be the smallest number that can alter 1.0 by
  155. C                 subtraction.
  156. C       XMIN    - the smallest non-vanishing normalized floating-point
  157. C                 power of the radix, i.e.,  XMIN = FLOAT(IBETA)**MINEXP
  158. C       XMAX    - the largest finite floating-point number.  In
  159. C                 particular  XMAX = (1.0-EPSNEG)*FLOAT(IBETA)**MAXEXP
  160. C                 Note - on some machines  XMAX  will be only the
  161. C                 second, or perhaps third, largest number, being
  162. C                 too small by 1 or 2 units in the last digit of
  163. C                 the significand.
  164. C
  165. C     Latest revision - December 4, 1987
  166. C
  167. C     Author - W. J. Cody
  168. C              Argonne National Laboratory
  169. C
  170. C-----------------------------------------------------------------------
  171. }
  172. VAR
  173.        I,L, ITEMP,IZ,J,K,
  174.        MX,NXRES: LONGINT;
  175.        A,B,BETA,BETAIN,BETAH,ONE,T,TEMP,TEMPA,
  176.        TEMP1,TWO,Y,Z,ZERO: REAL;
  177.        CONV: ARRAY [0..10] OF REAL;
  178.  
  179. LABEL 10, 20,100, 210, 220, 300, 320, 400, 410, 420, 430, 440, 450, 460, 500, 520;
  180.  
  181. BEGIN
  182. {-----------------------------------------------------------------------}
  183. for l:= 1 to 10 do
  184.     CONV [l] := l;
  185.  
  186.       ONE  := CONV [1];
  187.       TWO  := ONE + ONE;
  188.       ZERO := ONE - ONE;
  189. {-----------------------------------------------------------------------
  190. C  Determine IBETA, BETA ala Malcolm.
  191. C-----------------------------------------------------------------------}
  192.       A := ONE;
  193.    10: A := A + A;
  194.          TEMP  := A+ONE;
  195.          TEMP1 := TEMP-A;
  196.          IF (TEMP1-ONE = ZERO) THEN
  197.             GOTO 10;
  198.       B := ONE;
  199.    20: B := B + B;
  200.          TEMP := A+B;
  201.          ITEMP := TRUNC (TEMP-A);
  202.          IF (ITEMP = 0) THEN
  203.             GOTO 20;
  204.       IBETA := ITEMP;
  205.       BETA  := CONV[IBETA];
  206. {-----------------------------------------------------------------------
  207. C  Determine IT, IRND.
  208. C-----------------------------------------------------------------------}
  209.       IT := 0;
  210.       B  := ONE;
  211.   100: IT := IT + 1;
  212.          B := B * BETA;
  213.          TEMP := B+ONE;
  214.          TEMP1 := TEMP-B;
  215.          IF (TEMP1-ONE = ZERO) THEN
  216.             GOTO 100;
  217.       IRND := 0;
  218.       BETAH := BETA / TWO;
  219.       TEMP := A+BETAH;
  220.       IF (TEMP-A <> ZERO) THEN
  221.          IRND := 1;
  222.       TEMPA := A + BETA;
  223.       TEMP := TEMPA+BETAH;
  224.       IF ((IRND = 0) AND (TEMP-TEMPA <> ZERO))
  225.          THEN IRND := 2;
  226. {-----------------------------------------------------------------------
  227. C  Determine NEGEP, EPSNEG.
  228. C-----------------------------------------------------------------------}
  229.       NEGEP := IT + 3;
  230.       BETAIN := ONE / BETA;
  231.       A := ONE;
  232.       FOR I := 1 TO NEGEP DO BEGIN
  233.          A := A * BETAIN;
  234.       END;
  235.       B := A;
  236.   210:TEMP := ONE-A;
  237.          IF (TEMP-ONE <> ZERO) THEN
  238.            GOTO 220;
  239.          A := A * BETA;
  240.          NEGEP := NEGEP - 1;
  241.       GOTO 210;
  242.   220:NEGEP := -NEGEP;
  243.       EPSNEG:= A;
  244. {-----------------------------------------------------------------------
  245. C  Determine MACHEP, EPS.
  246. C-----------------------------------------------------------------------}
  247.  
  248.        MACHEP := -IT - 3;
  249.        A := B;
  250.   300: TEMP := ONE+A;
  251.          IF (TEMP-ONE <> ZERO) THEN
  252.             GOTO 320;
  253.          A := A * BETA;
  254.          MACHEP := MACHEP + 1;
  255.       GOTO 300;
  256.   320: EPS := A;
  257. {-----------------------------------------------------------------------
  258. C  Determine NGRD.
  259. C-----------------------------------------------------------------------}
  260.       NGRD := 0;
  261.       TEMP := ONE+EPS;
  262.       IF ((IRND = 0) AND (TEMP*ONE-ONE <> ZERO)) THEN
  263.          NGRD := 1;
  264. {-----------------------------------------------------------------------
  265. C  Determine IEXP, MINEXP, XMIN.
  266. C
  267. C  Loop to determine largest I and K = 2**I such that
  268. C         (1/BETA) ** (2**(I))
  269. C  does not underflow.
  270. C  Exit from loop is signaled by an underflow.
  271. C-----------------------------------------------------------------------}
  272.       I := 0;
  273.       K := 1;
  274.       Z := BETAIN;
  275.       T := ONE + EPS;
  276.       NXRES := 0;
  277.   400:   Y := Z;
  278.          Z := Y * Y;
  279. {-----------------------------------------------------------------------
  280. C  Check for underflow here.
  281. C-----------------------------------------------------------------------}
  282.  
  283.          A := Z * ONE;
  284.          TEMP := Z * T;
  285.          IF ((A+A = ZERO) OR (ABS(Z) >= Y)) THEN
  286.             GOTO 410;
  287.          TEMP1 := TEMP * BETAIN;
  288.          IF (TEMP1*BETA = Z) THEN
  289.             GOTO 410;
  290.          I := I + 1;
  291.          K := K + K;
  292.       GOTO 400;
  293.   410: IF (IBETA = 10) THEN
  294.          GOTO 420;
  295.       IEXP := I + 1;
  296.       MX := K + K;
  297.       GOTO 450;
  298. {-----------------------------------------------------------------------
  299. C  This segment is for decimal machines only.
  300. C-----------------------------------------------------------------------}
  301.   420: IEXP := 2;
  302.       IZ := IBETA;
  303.   430: IF (K < IZ) THEN
  304.          GOTO 440;
  305.          IZ := IZ * IBETA;
  306.          IEXP := IEXP + 1;
  307.       GOTO 430;
  308.   440: MX := IZ + IZ - 1;
  309.  
  310. {-----------------------------------------------------------------------
  311. C  Loop to determine MINEXP, XMIN.
  312. C  Exit from loop is signaled by an underflow.
  313. C-----------------------------------------------------------------------}
  314.  
  315.   450:   XMIN := Y;
  316.          Y := Y * BETAIN;
  317. {-----------------------------------------------------------------------
  318. C  Check for underflow here.
  319. C-----------------------------------------------------------------------}
  320.          A    := Y * ONE;
  321.          TEMP := Y * T;
  322.          IF (((A+A) = ZERO) OR (ABS(Y) >= XMIN)) THEN
  323.              GOTO 460;
  324.          K := K + 1;
  325.          TEMP1 := TEMP * BETAIN;
  326.          IF ((TEMP1*BETA <> Y) OR (TEMP = Y)) THEN
  327.                GOTO 450
  328.             ELSE BEGIN
  329.                NXRES := 3;
  330.                XMIN  := Y;
  331.             END;
  332.   460: MINEXP := -K;
  333.  
  334. {-----------------------------------------------------------------------
  335. C  Determine MAXEXP, XMAX.
  336. C-----------------------------------------------------------------------}
  337.       IF ((MX > K+K-3) OR (IBETA = 10)) THEN
  338.          GOTO 500;
  339.       MX := MX + MX;
  340.       IEXP := IEXP + 1;
  341. 500:  MAXEXP := MX + MINEXP;
  342.  
  343. {-----------------------------------------------------------------
  344. C  Adjust IRND to reflect partial underflow.
  345. C-----------------------------------------------------------------}
  346.  
  347.       IRND := IRND + NXRES;
  348.  
  349. {-----------------------------------------------------------------
  350. C  Adjust for IEEE-style machines.
  351. C-----------------------------------------------------------------}
  352.  
  353.       IF (IRND >= 2) THEN
  354.          MAXEXP := MAXEXP - 2;
  355.  
  356. {-----------------------------------------------------------------
  357. C  Adjust for machines with implicit leading bit in binary
  358. C  significand, and machines with radix point at extreme
  359. C  right of significand.
  360. C-----------------------------------------------------------------}
  361.       I := MAXEXP + MINEXP;
  362.       IF ((IBETA = 2) AND (I = 0)) THEN
  363.          MAXEXP := MAXEXP - 1;
  364.       IF (I > 20) THEN
  365.          MAXEXP := MAXEXP - 1;
  366.       IF (A <> Y) THEN
  367.          MAXEXP := MAXEXP - 2;
  368.       XMAX := ONE - EPSNEG;
  369.       IF (XMAX*ONE <> XMAX) THEN
  370.          XMAX := ONE - BETA * EPSNEG;
  371.       XMAX := XMAX / (BETA * BETA * BETA * XMIN);
  372.       I := MAXEXP + MINEXP + 3;
  373.       IF (I <= 0) THEN
  374.          GOTO 520;
  375.       FOR L := 1 TO I DO BEGIN
  376.           IF (IBETA = 2) THEN XMAX := XMAX + XMAX;
  377.           IF (IBETA <>2) THEN XMAX := XMAX * BETA;
  378.       END;
  379.   520:
  380.   END;
  381.  
  382.  
  383.  
  384.  
  385. VAR
  386.            I,IBETA,IEXP,IOUT,IRND,IT,I1,J,K1,K2,K3,MACHEP,
  387.            MAXEXP,MINEXP,N,NEGEP,NGRD: LONGINT;
  388.  
  389.            A,AIT,ALBETA,B,BETA,C,DEL,EIGHT,EPS,EPSNEG,HALF,ONE,T,
  390.            R6,R7,TENTH,W,X,XL,XMAX,XMIN,XN,X1,Y,Z,ZERO,ZZ: REAL;
  391.  
  392. LABEL      100, 110, 120, 150, 160, 220, 230, 240, 300;
  393.  
  394. BEGIN
  395.       MACHAR(IBETA,IT,IRND,NGRD,MACHEP,NEGEP,IEXP,MINEXP,
  396.              MAXEXP,EPS,EPSNEG,XMIN,XMAX);
  397.  
  398.    WriteLn ('MACHAR DETERMINED THE FOLLOWING PARAMETERS OF THE FLOATING-POINT ARITHEMTIC');
  399.    WriteLn;
  400.    WriteLn ('Radix for floating-point representation:        ', IBETA);
  401.    WriteLn ('Number of base ', IBETA:2, ' digits in significand:        ', IT);
  402.    IF IBETA <> 10 THEN
  403.       WriteLn ('Number of bits used to represent the exponent:  ', IEXP)
  404.    ELSE
  405.       WriteLn ('Number of decimal places used for the exponent:  ', IEXP);
  406.    WriteLn ('Smallest positive eps such that 1+eps <> 1 :   ', EPS:14, ' = ', IBETA, ' ** -', ABS(MACHEP));
  407.    WriteLn ('Smallest positive eps such that 1-eps <> 1 :   ', EPSNEG:14, ' = ', IBETA, ' ** -', ABS(NEGEP));
  408.    WriteLn ('Smallest pos. normalized floating-point number:', XMIN:14, ' = ', IBETA, ' ** -', ABS(MINEXP)) ;
  409.    WriteLn ('Largest floating-point number:                 ', XMAX:14, ' = ', IBETA, ' ** +', ABS(MAXEXP), ' - 1');
  410.    WriteLn;
  411.    Write   ('Floating-point arithmetic ');
  412.    CASE IRND MOD 3 OF
  413.        0: WriteLn ('chops');
  414.        1: WriteLn ('rounds, but not IEEE style,');
  415.        2: WriteLn ('rounds IEEE style');
  416.    END;
  417.    IF IRND DIV 3 = 1 THEN
  418.       WriteLn ('and supports gradual underflow')
  419.    ELSE
  420.       WriteLn ('and does not support gradual underflow');
  421.  
  422.  
  423.       BETA   := IBETA;
  424.       ALBETA := LN (BETA);
  425.       AIT    := IT;
  426.       J      := IT DIV 3;
  427.       ZERO   := 0.0;
  428.       HALF   := 0.5;
  429.       EIGHT  := 8.0;
  430.       TENTH  := 0.1;
  431.       ONE    := 1.0;
  432.       C      := ONE;
  433.  
  434.       FOR I := 1 TO J DO BEGIN
  435.         C := C / BETA;
  436.       END;
  437.  
  438.       B  := ONE + C;
  439.       A  := ONE - C;
  440.       N  := 10000;
  441.       XN := N;
  442.       I1 := 0;
  443.  
  444. {-----------------------------------------------------------------
  445.       RANDOM ARGUMENT ACCURACY TESTS
  446.  -----------------------------------------------------------------}
  447.  
  448.       FOR J := 1 TO 4 DO BEGIN
  449.          K1 := 0;
  450.          K3 := 0;
  451.          X1 := ZERO;
  452.          R6 := ZERO;
  453.          R7 := ZERO;
  454.          DEL:= (B - A) / XN;
  455.          XL := A;
  456.  
  457.          FOR I := 1 TO N DO BEGIN
  458.             X  := DEL * REN(I1) + XL;
  459.             IF (J <> 1) THEN
  460.                 GOTO 100;
  461.             Y := X - HALF;
  462.             Y := Y - HALF;
  463.             ZZ:= LN (X);
  464.             Z := (Y * (ONE / 3.0 - Y / 4.0) - HALF) * Y * Y + Y;
  465.             GOTO 150;
  466.   100:      IF (J <> 2) THEN
  467.                GOTO 110;
  468.             X := X + EIGHT;
  469.             X := X - EIGHT;
  470.             Y := X / 16.0;
  471.             Y := X + Y;
  472.             Z := LN (X);
  473.             ZZ:= LN (Y);
  474.             ZZ:= ZZ - 7.7746816434842581e-5;
  475.             ZZ:= ZZ - 31.0/512.0;
  476.             GOTO 150;
  477.   110:      IF (J <> 3) THEN
  478.                GOTO 120;
  479.             X := X + EIGHT;
  480.             X := X - EIGHT;
  481.             T := X * TENTH;
  482.             Y := X + T;
  483.             Z := LOG (X);
  484.             ZZ:= LOG (Y);
  485.             ZZ:= ZZ - 3.7706015822504075e-4;
  486.             ZZ:= ZZ - 21.0/512.0;
  487.             GOTO 150;
  488.   120:      T := X * X;
  489.             Z := LN (T);
  490.             ZZ:= LN (X);
  491.             ZZ:= ZZ + ZZ;
  492.  
  493.   150:      IF (Z <> ZERO) THEN
  494.                W := (Z - ZZ) / Z
  495.             ELSE IF ZZ <> 0 THEN
  496.                W := ONE;
  497.             IF (W > ZERO) THEN
  498.                K1 := K1 + 1;
  499.             IF (W < ZERO) THEN
  500.                K3 := K3 + 1;
  501.             W := ABS (W);
  502.             IF (W <= R6) THEN
  503.                GOTO 160;
  504.             R6 := W;
  505.             X1 := X;
  506.   160:      R7 := R7 + W * W;
  507.             XL := XL + DEL;
  508.          END;
  509.  
  510.          K2 := N - K3 - K1;
  511.          R7 := SQRT (R7/XN);
  512.          IF (J = 1) THEN BEGIN
  513.             WRITELN;
  514.             WRITELN ;
  515.             WRITELN ('TEST OF LN (X) VS T.S. EXPANSION OF LN(1+Y)');
  516.             WRITELN;
  517.             END;
  518.          IF (J = 2) THEN BEGIN
  519.             WRITELN;
  520.             WRITELN;
  521.             WRITELN ('TEST OF LN(X) VS LN(17X/16)-LN(17/16)');
  522.             WRITELN;
  523.             END;
  524.          IF (J = 3) THEN BEGIN
  525.             WRITELN;
  526.             WRITELN;
  527.             WRITELN ('TEST OF LOG10(X) VS LOG10(11X/10)-LOG10(11/10)');
  528.             WRITELN;
  529.             END;
  530.          IF (J = 4) THEN BEGIN
  531.             WRITELN;
  532.             WRITELN;
  533.             WRITELN ('TEST OF LN (X*X) VS 2*LN(X)');
  534.             WRITELN;
  535.             END;
  536.          IF (J = 1) THEN BEGIN
  537.             WRITELN (N, ' RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL');
  538.             WRITELN ('(1-EPS,1+EPS), WHERE EPS = ', C);
  539.             WRITELN;
  540.             END;
  541.          IF (J <>1) THEN BEGIN
  542.             WRITELN (N, ' RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL');
  543.             WRITELN ('(', A, ',', B, ')');
  544.             WRITELN;
  545.             END;
  546.          IF (J <>3) THEN BEGIN
  547.             WRITELN ('LN (X) WAS LARGER', K1:6, ' TIMES');
  548.             WRITELN ('           AGREED', K2:6, ' TIMES');
  549.             WRITELN ('  AND WAS SMALLER', K3:6, ' TIMES');
  550.             END;
  551.          IF (J = 3) THEN BEGIN
  552.             WRITELN ('LOG (X) WAS LARGER', K1:6, ' TIMES');
  553.             WRITELN ('            AGREED', K2:6, ' TIMES');
  554.             WRITELN ('   AND WAS SMALLER', K3:6, ' TIMES');
  555.             END;
  556.          WRITELN;
  557.          WRITELN ('THERE ARE ', IT, ' BASE ', IBETA,
  558.                   ' SIGNIFICANT DIGITS IN A FLOATING-POINT NUMBER');
  559.          WRITELN;
  560.          W := -999;
  561.          IF (R6 <> ZERO) THEN
  562.             W := LN (ABS(R6))/ALBETA;
  563.          WRITELN ('THE MAXIMUM RELATIVE ERROR OF          ', R6:12,
  564.                   ' = ', IBETA, ' **', W:7:2);
  565.          WRITELN ('OCCURED FOR X = ', X1);
  566.          W := MAX1 (AIT+W,ZERO);
  567.          WRITELN;
  568.          WRITELN ('THE ESTIMATED LOSS OF BASE ', IBETA,
  569.                   ' SIGNIFICANT DIGITS IS        ', W:7:2);
  570.          W := -999.0;
  571.          IF (R7 <> ZERO) THEN
  572.             W := LN (ABS(R7))/ALBETA;
  573.          WRITELN;
  574.          WRITELN ('THE ROOT MEAN SQUARE RELATIVE ERROR WAS', R7:12,
  575.                   ' = ', IBETA, ' **' , W:7:2);
  576.          W := MAX1 (AIT+W,ZERO);
  577.          WRITELN;
  578.          WRITELN ('THE ESTIMATED LOSS OF BASE ', IBETA,
  579.                   ' SIGNIFICANT DIGITS IS        ', W:7:2);
  580.          IF (J > 1) THEN
  581.             GOTO 230;
  582.          A := SQRT (HALF);
  583.          B := 15.0 / 16.0;
  584.          GOTO 300;
  585.   230:   IF (J > 2) THEN
  586.             GOTO 240;
  587.          A := SQRT (TENTH);
  588.          B := 0.9;
  589.          GOTO 300;
  590.   240:   A := 16.0;
  591.          B := 240.0;
  592.   300:
  593.       END;
  594.  
  595. {-----------------------------------------------------------------
  596.       SPECIAL TESTS
  597.  -----------------------------------------------------------------}
  598.       WRITELN;
  599.       WRITELN;
  600.       WRITELN ('SPECIAL TESTS');
  601.       WRITELN;
  602.       WRITELN ('THE IDENTITY  LN (X) = - LN (1/X)  WILL BE TESTED');
  603.       WRITELN;
  604.       WRITELN ('          X           F(X) + F(1/X)');
  605.       WRITELN;
  606.  
  607.       FOR I := 1 TO 5 DO BEGIN
  608.          X := REN(I1);
  609.          T := X + X;
  610.          X := T + 15.0;
  611. (*         X := X + X + 15.0;*)
  612.          Y := ONE / X;
  613.          T := LN (X);
  614.          Z := LN (Y);
  615.          Z := Z + T;
  616. (*         Z := LN (X) + LN (Y);*)
  617.          WRITELN (X:18, Z:18);
  618.       END;
  619.  
  620.       WRITELN;
  621.       WRITELN;
  622.       WRITELN ('TEST OF SPECIAL ARGUMENTS');
  623.       WRITELN;
  624.       X := ONE;
  625.       Y := LN (X);
  626.       WRITELN ('LN (1.0) =                   ', Y:15);
  627.       X := XMIN;
  628.       Y := LN (X);
  629.       WRITELN ('LN (XMIN)= LN (', X:10, ') = ', Y:15);
  630.       X := XMAX;
  631.       Y := LN (X);
  632.       WRITELN ('LN (XMAX)= LN (', X:10, ') = ', Y:15);
  633.  
  634. {-----------------------------------------------------------------
  635.       TEST OF ERROR RETURNS
  636.  -----------------------------------------------------------------}
  637.  
  638.       WRITELN;
  639.       WRITELN;
  640.       WRITELN ('TEST OF ERROR RETURNS');
  641.       WRITELN;
  642.       X := -2.0;
  643.       WRITELN ('LN WILL BE CALLED WITH THE ARGUMENT ',  X:15);
  644.       WRITELN ('THIS SHOULD TRIGGER AN ERROR MESSAGE');
  645.       Y := LN (X);
  646.       WRITELN ('LN RETURNED THE VALUE ', Y:15);
  647.       X := ZERO;
  648.       WRITELN ('LN WILL BE CALLED WITH THE ARGUMENT ',  X:15);
  649.       WRITELN ('THIS SHOULD TRIGGER AN ERROR MESSAGE');
  650.       Y := LN (X);
  651.       WRITELN ('LN RETURNED THE VALUE ', Y:15);
  652.       WRITELN ('THIS CONCLUDES THE TESTS');
  653. END.
  654.  
  655.  
  656.