C ABCDEFGHIJKLMNOPQRSTUVWXYZ$0123456789+-*/=(),.                        MP000011
C                                                                       MP000021
C                        MP  (VERSION 780802)                           MP000031
C                        ********************                           MP000041
C                                                                       MP000051
C $$                   ******  COMMENTS  ******                         MP000061
C                                                                       MP000071
C MP IS A MULTIPLE-PRECISION FLOATING-POINT ARITHMETIC PACKAGE.         MP000081
C IT IS ALMOST COMPLETELY MACHINE-INDEPENDENT, AND SHOULD               MP000091
C RUN ON ANY MACHINE WITH AN ANSI STANDARD FORTRAN COMPILER,            MP000101
C SUFFICIENT MEMORY, AND A WORDLENGTH OF AT LEAST 16 BITS.              MP000111
C                                                                       MP000121
C FOR A GENERAL DESCRIPTION OF THE PHILOSOPHY AND DESIGN OF MP,         MP000131
C SEE - R. P. BRENT, A FORTRAN MULTIPLE-PRECISION ARITHMETIC            MP000141
C PACKAGE, ACM TRANS. MATH. SOFTWARE 4 (MARCH 1978), 57-70.             MP000151
C SOME ADDITIONAL DETAILS ARE GIVEN IN THE SAME ISSUE, 71-81.           MP000161
C FOR DETAILS OF THE IMPLEMENTATION, CALLING SEQUENCES ETC. SEE         MP000171
C THE MP USERS GUIDE.                                                   MP000181
C                                                                       MP000191
C MP IS NORMALLY DISTRIBUTED IN FIVE FILES.  ALL HAVE 80 CHARACTER      MP000201
C LOGICAL RECORDS AND USE ONLY THE (STANDARD FORTRAN) CHARACTERS        MP000211
C APPEARING IN LINE MP000011.                                           MP000221
C                                                                       MP000231
C FILE 1 - THESE COMMENTS AND EXAMPLE PROGRAM.                          MP000241
C FILE 2 - MP SUBROUTINES (EXCLUDING EXAMPLE AND TEST PROGRAMS).        MP000251
C FILE 3 - TEST PROGRAMS (NOT USING AUGMENT INTERFACE).                 MP000261
C FILE 4 - MP USERS GUIDE.                                              MP000271
C FILE 5 - AUGMENT DESCRIPTION DECK AND JACOBI PROGRAM USING IT.        MP000281
C          (MP MAY BE USED WITH THE AUGMENT PREPROCESSOR.  FOR          MP000291
C           DETAILS SEE SECTION 4 OF THE USERS GUIDE.)                  MP000301
C                                                                       MP000311
C TO INSTALL MP, READ THESE FIVE FILES.  PRINT FILE 4 (THE USERS GUIDE) MP000321
C USING THE FIRST CHARACTER (BLANK, 0 OR 1) AS STANDARD FORTRAN         MP000331
C PRINTER CONTROL.  THEN FOLLOW THE INSTRUCTIONS GIVEN IN SECTION 5     MP000341
C OF THE USERS GUIDE.                                                   MP000351
C                                                                       MP000361
C                                                                       MP000371
C                                                                       MP000381
C $$                   ******  EXAMPLE  ******                          MP005460
C                                                                       MP005470
C THIS PROGRAM COMPUTES PI AND EXP(PI*SQRT(163/9)) TO 100               MP005480
C DECIMAL PLACES, AND EXP(PI*SQRT(163)) TO 90 DECIMAL PLACES,           MP005490
C AND WRITES THEM ON LOGICAL UNIT 6.  EXECUTION                         MP005500
C TIME ON A UNIVAC 1108 (WITH FORTRAN SE1D) IS 1.051 SECONDS.           MP005510
C                                                                       MP005520
C TO RUN EXAMPLE THE FOLLOWING MP ROUTINES ARE REQUIRED - MPABS,        MP005530
C MPADD, MPADDI, MPADD2, MPADD3, MPART1, MPCHK, MPCIM, MPCLR, MPCMF,    MP005540
C MPCMI, MPCMPR, MPCMR, MPCOMP, MPCQM, MPCRM, MPDIVI, MPERR,            MP005550
C MPEXP, MPEXP1, MPGCD, MPLNI, MPL235, MPMAXR, MPMLP, MPMUL,            MP005560
C MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2, MPOVFL, MPPI,           MP005570
C MPPWR, MPQPWR, MPREC, MPROOT, MPSET, MPSTR, MPSUB, MPUNFL.            MP005580
C                                                                       MP005590
C CORRECT OUTPUT (EXCLUDING HEADINGS) IS AS FOLLOWS                     MP005600
C                                                                       MP005610
C                  3.14159265358979323846264338327950288419716939937510 MP005620
C                    58209749445923078164062862089986280348253421170680 MP005630
C             640320.00000000060486373504901603947174181881853947577148 MP005640
C                    57603665918194652218258286942536340815822646477590 MP005650
C 262537412640768743.99999999999925007259719818568887935385633733699086 MP005660
C                    2707537410378210647910118607312951181346           MP005670
C                                                                       MP005680
C CERTAIN PARAMETERS AND WORKING SPACE IN COMMON.                       MP005690
      COMMON B, T, M, LUN, MXR, R                                       MP005700
C                                                                       MP005710
C MPEXP REQUIRES 4T+10 WORDS AND WE HAVE T .LE. 62 IF WORDLENGTH        MP005720
C AT LEAST 16 BITS, SO 4T+10 .LE. 258.  DIMENSIONS CAN BE REDUCED       MP005730
C IF WORDLENGTH IS GREATER THAN 16 BITS.                                MP005740
      INTEGER B, T, R(258)                                              MP005750
C                                                                       MP005760
C VARIABLES NEED T+2 .LE. 64 WORDS AND ALLOW 110 CHARACTERS FOR         MP005770
C DECIMAL OUTPUT                                                        MP005780
      INTEGER PI(64), X(64), C(110)                                     MP005790
C                                                                       MP005800
C CALL MPSET TO SET OUTPUT LOGICAL UNIT = 6 AND EQUIVALENT              MP005810
C NUMBER OF DECIMAL PLACES TO AT LEAST 110.  THE LAST TWO               MP005820
C PARAMETERS ARE THE DIMENSIONS OF PI (OR X) AND R.                     MP005830
      CALL MPSET (6, 110, 64, 258)                                      MP005840
C                                                                       MP005850
C COMPUTE MULTIPLE-PRECISION PI                                         MP005860
      CALL MPPI(PI)                                                     MP005870
C                                                                       MP005880
C CONVERT TO PRINTABLE FORMAT (F110.100) AND WRITE                      MP005890
      CALL MPOUT (PI, C, 110, 100)                                      MP005900
      WRITE (LUN, 10) B, T, C                                           MP005910
   10 FORMAT (32H1EXAMPLE OF MP PACKAGE,   BASE =, I9,                  MP005920
     $  12H,   DIGITS =, I4 /// 11H PI TO 100D //                       MP005930
     $  11X, 60A1 / 21X, 50A1)                                          MP005940
C                                                                       MP005950
C SET X = SQRT(163/9), THEN MULTIPLY BY PI                              MP005960
      CALL MPQPWR (163, 9, 1, 2, X)                                     MP005970
      CALL MPMUL (X, PI, X)                                             MP005980
C                                                                       MP005990
C SET X = EXP(X)                                                        MP006000
      CALL MPEXP (X, X)                                                 MP006010
C                                                                       MP006020
C CONVERT TO PRINTABLE FORMAT AND WRITE                                 MP006030
      CALL MPOUT (X, C, 110, 100)                                       MP006040
      WRITE (LUN, 20) C                                                 MP006050
   20 FORMAT (/ 28H EXP(PI*SQRT(163/9)) TO 100D //                      MP006060
     $        11X, 60A1 / 21X, 50A1)                                    MP006070
C                                                                       MP006080
C SET X = X**3 = EXP(PI*SQRT(163))                                      MP006090
      CALL MPPWR (X, 3, X)                                              MP006100
C                                                                       MP006110
C WRITE IN FORMAT F110.90                                               MP006120
      CALL MPOUT (X, C, 110, 90)                                        MP006130
      WRITE (LUN, 30) C                                                 MP006140
   30 FORMAT (/ 25H EXP(PI*SQRT(163)) TO 90D //                         MP006150
     $        1X, 70A1 / 21X, 40A1)                                     MP006160
      STOP                                                              MP006170
      END                                                               MP006180
      SUBROUTINE MPABS (X, Y)                                           MP006200
C SETS Y = ABS(X) FOR MP NUMBERS X AND Y
      INTEGER X(1), Y(1)
      CALL MPSTR (X, Y)
      Y(1) = IABS(Y(1))
      RETURN
      END
      SUBROUTINE MPADD (X, Y, Z)                                        MP006280
C ADDS X AND Y, FORMING RESULT IN Z, WHERE X, Y AND Z ARE MP
C NUMBERS.  FOUR GUARD DIGITS ARE USED, AND THEN R*-ROUNDING.
      INTEGER X(1), Y(1), Z(1)
      CALL MPADD2 (X, Y, Z, Y, 0)
      RETURN
      END
      SUBROUTINE MPADDI (X, IY, Z)                                      MP006360
C ADDS MULTIPLE-PRECISION X TO INTEGER IY
C GIVING MULTIPLE-PRECISION Z.
C DIMENSION OF R IN CALLING PROGRAM MUST BE
C AT LEAST 2T+6 (BUT Z(1) MAY BE R(T+5)).
      COMMON B, T, M, LUN, MXR, R
C DIMENSION R(6) BECAUSE RALPH COMPILER ON UNIVAC 1100 COMPUTERS
C OBJECTS TO DIMENSION R(1).
      INTEGER B, T, R(6), X(1), Z(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (2, 6)
      CALL MPCIM (IY, R(T+5))
      CALL MPADD (X, R(T+5), Z)
      RETURN
      END
      SUBROUTINE MPADDQ (X, I, J, Y)                                    MP006520
C ADDS THE RATIONAL NUMBER I/J TO MP NUMBER X, MP RESULT IN Y
C DIMENSION OF R MUST BE AT LEAST 2T+6
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(6), X(1), Y(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (2, 6)
      CALL MPCQM (I, J, R(T+5))
      CALL MPADD (X, R(T+5), Y)
      RETURN
      END
      SUBROUTINE MPADD2 (X, Y, Z, Y1, TRUNC)                            MP006640
C CALLED BY MPADD, MPSUB ETC.
C X, Y AND Z ARE MP NUMBERS, Y1 AND TRUNC ARE INTEGERS.
C TO FORCE CALL BY REFERENCE RATHER THAN VALUE/RESULT, Y1 IS
C DECLARED AS AN ARRAY, BUT ONLY Y1(1) IS EVER USED.
C SETS Z = X + Y1(1)*ABS(Y), WHERE Y1(1) = +- Y(1).
C IF TRUNC.EQ.0 R*-ROUNDING IS USED, OTHERWISE TRUNCATION.
C R*-ROUNDING IS DEFINED IN KUKI AND CODI, COMM. ACM
C 16(1973), 223.  (SEE ALSO BRENT, IEEE TC-22(1973), 601.)
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2), Z(1), Y1(1), TRUNC
      INTEGER S, ED, RS, RE
C CHECK FOR X OR Y ZERO
      IF (X(1).NE.0) GO TO 20
C X = 0 OR NEGLIGIBLE, SO RESULT = +-Y
   10 CALL MPSTR(Y, Z)
      Z(1) = Y1(1)
      RETURN
   20 IF (Y1(1).NE.0) GO TO 40
C Y = 0 OR NEGLIGIBLE, SO RESULT = X
   30 CALL MPSTR (X, Z)
      RETURN
C COMPARE SIGNS
   40 S = X(1)*Y1(1)
      IF (IABS(S).LE.1) GO TO 60
      CALL MPCHK (1, 4)
      WRITE (LUN, 50)
   50 FORMAT (44H *** SIGN NOT 0, +1 OR -1 IN CALL TO MPADD2,,
     $        33H POSSIBLE OVERWRITING PROBLEM ***)
      CALL MPERR
      Z(1) = 0
      RETURN
C COMPARE EXPONENTS
   60 ED = X(2) - Y(2)
      MED = IABS(ED)
      IF (ED) 90, 70, 120
C EXPONENTS EQUAL SO COMPARE SIGNS, THEN FRACTIONS IF NEC.
   70 IF (S.GT.0) GO TO 100
      DO 80 J = 1, T
      IF (X(J+2) - Y(J+2)) 100, 80, 130
   80 CONTINUE
C RESULT IS ZERO
      Z(1) = 0
      RETURN
C HERE EXPONENT(Y) .GE. EXPONENT(X)
   90 IF (MED.GT.T) GO TO 10
  100 RS = Y1(1)
      RE = Y(2)
      CALL MPADD3 (X, Y, S, MED, RE)
C NORMALIZE, ROUND OR TRUNCATE, AND RETURN
  110 CALL MPNZR (RS, RE, Z, TRUNC)
      RETURN
C ABS(X) .GT. ABS(Y)
  120 IF (MED.GT.T) GO TO 30
  130 RS = X(1)
      RE = X(2)
      CALL MPADD3 (Y, X, S, MED, RE)
      GO TO 110
      END
      SUBROUTINE MPADD3 (X, Y, S, MED, RE)                              MP007240
C CALLED BY MPADD2, DOES INNER LOOPS OF ADDITION
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), S, RE, C, TED
      TED = T + MED
      I2 = T + 4
      I = I2
      C = 0
C CLEAR GUARD DIGITS TO RIGHT OF X DIGITS
   10 IF (I.LE.TED) GO TO 20
      R(I) = 0
      I = I - 1
      GO TO 10
   20 IF (S.LT.0) GO TO 130
C HERE DO ADDITION, EXPONENT(Y) .GE. EXPONENT(X)
      IF (I.LE.T) GO TO 40
   30 J = I - MED
      R(I) = X(J+2)
      I = I - 1
      IF (I.GT.T) GO TO 30
   40 IF (I.LE.MED) GO TO 60
      J = I - MED
      C = Y(I+2) + X(J+2) + C
      IF (C.LT.B) GO TO 50
C CARRY GENERATED HERE
      R(I) = C - B
      C = 1
      I = I - 1
      GO TO 40
C NO CARRY GENERATED HERE
   50 R(I) = C
      C = 0
      I = I - 1
      GO TO 40
   60 IF (I.LE.0) GO TO 90
      C = Y(I+2) + C
      IF (C.LT.B) GO TO 70
      R(I) = 0
      C = 1
      I = I - 1
      GO TO 60
   70 R(I) = C
      I = I - 1
C NO CARRY POSSIBLE HERE
   80 IF (I.LE.0) RETURN
      R(I) = Y(I+2)
      I = I - 1
      GO TO 80
   90 IF (C.EQ.0) RETURN
C MUST SHIFT RIGHT HERE AS CARRY OFF END
      I2P = I2 + 1
      DO 100 J = 2, I2
      I = I2P - J
  100 R(I+1) = R(I)
      R(1) = 1
      RE = RE + 1
      RETURN
C HERE DO SUBTRACTION, ABS(Y) .GT. ABS(X)
  110 J = I - MED
      R(I) = C - X(J+2)
      C = 0
      IF (R(I).GE.0) GO TO 120
C BORROW GENERATED HERE
      C = -1
      R(I) = R(I) + B
  120 I = I - 1
  130 IF (I.GT.T) GO TO 110
  140 IF (I.LE.MED) GO TO 160
      J = I - MED
      C = Y(I+2) + C - X(J+2)
      IF (C.GE.0) GO TO 150
C BORROW GENERATED HERE
      R(I) = C + B
      C = -1
      I = I - 1
      GO TO 140
C NO BORROW GENERATED HERE
  150 R(I) = C
      C = 0
      I = I - 1
      GO TO 140
  160 IF (I.LE.0) RETURN
      C = Y(I+2) + C
      IF (C.GE.0) GO TO 70
      R(I) = C + B
      C = -1
      I = I - 1
      GO TO 160
      END
      SUBROUTINE MPART1 (N, Y)                                          MP008140
C COMPUTES MP Y = ARCTAN(1/N), ASSUMING INTEGER N .GT. 1.
C USES SERIES ARCTAN(X) = X - X**3/3 + X**5/5 - ...
C DIMENSION OF R IN CALLING PROGRAM MUST BE
C AT LEAST 2T+6
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), Y(2), B2, TS
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (2, 6)
      IF (N.GT.1) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (35H *** N .LE. 1 IN CALL TO MPART1 ***)
      CALL MPERR
      Y(1) = 0
      RETURN
   20 I2 = T + 5
      TS = T
C SET SUM TO X = 1/N
      CALL MPCQM (1, N, Y)
C SET ADDITIVE TERM TO X
      CALL MPSTR (Y, R(I2))
      I = 1
      ID = 0
C ASSUME AT LEAST 16-BIT WORD.
      B2 = MAX0 (B, 64)
      IF (N.LT.B2) ID = (7*B2*B2)/(N*N)
C MAIN LOOP.  FIRST REDUCE T IF POSSIBLE
   30 T = TS + 2 + R(I2+1) - Y(2)
      IF (T.LT.2) GO TO 60
      T = MIN0 (T, TS)
C IF (I+2)*N**2 IS NOT REPRESENTABLE AS AN INTEGER THE DIVISION
C FOLLOWING HAS TO BE PERFORMED IN SEVERAL STEPS.
      IF (I.GE.ID)  GO TO 40
      CALL MPMULQ (R(I2), -I, (I+2)*N*N, R(I2))
      GO TO 50
   40 CALL MPMULQ (R(I2), -I, I+2, R(I2))
      CALL MPDIVI (R(I2), N, R(I2))
      CALL MPDIVI (R(I2), N, R(I2))
   50 I = I + 2
C RESTORE T
      T = TS
C ADD TO SUM, USING MPADD2 (FASTER THAN MPADD)
      CALL MPADD2 (R(I2), Y, Y, Y, 0)
      IF (R(I2).NE.0) GO TO 30
   60 T = TS
      RETURN
      END
      SUBROUTINE MPASIN (X, Y)                                          MP008620
C RETURNS Y = ARCSIN(X), ASSUMING ABS(X) .LE. 1,
C FOR MP NUMBERS X AND Y.
C Y IS IN THE RANGE -PI/2 TO +PI/2.
C METHOD IS TO USE MPATAN, SO TIME IS O(M(T)T).
C DIMENSION OF R MUST BE AT LEAST 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1)
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (5, 12)
      I3 = 4*T + 11
      IF (X(1).EQ.0) GO TO 30
      IF (X(2).LE.0) GO TO 40
C HERE ABS(X) .GE. 1.  SEE IF X = +-1
      CALL MPCIM (X(1), R(I3))
      IF (MPCOMP(X, R(I3)).NE.0) GO TO 10
C X = +-1 SO RETURN +-PI/2
      CALL MPPI (Y)
      CALL MPDIVI (Y, 2*R(I3), Y)
      RETURN
   10 WRITE (LUN, 20)
   20 FORMAT (40H *** ABS(X) .GT. 1 IN CALL TO MPASIN ***)
      CALL MPERR
   30 Y(1) = 0
      RETURN
C HERE ABS(X) .LT. 1 SO USE ARCTAN(X/SQRT(1 - X**2))
   40 I2 = I3 - (T+2)
      CALL MPCIM (1, R(I2))
      CALL MPSTR (R(I2), R(I3))
      CALL MPSUB (R(I2), X, R(I2))
      CALL MPADD (R(I3), X, R(I3))
      CALL MPMUL (R(I2), R(I3), R(I3))
      CALL MPROOT (R(I3), -2, R(I3))
      CALL MPMUL (X, R(I3), Y)
      CALL MPATAN (Y, Y)
      RETURN
      END
      SUBROUTINE MPATAN (X, Y)                                          MP008996
C RETURNS Y = ARCTAN(X) FOR MP X AND Y, USING AN O(T.M(T)) METHOD
C WHICH COULD EASILY BE MODIFIED TO AN O(SQRT(T)M(T))
C METHOD (AS IN MPEXP1). Y IS IN THE RANGE -PI/2 TO +PI/2.
C FOR AN ASYMPTOTICALLY FASTER METHOD, SEE - FAST MULTIPLE-
C PRECISION EVALUATION OF ELEMENTARY FUNCTIONS
C (BY R. P. BRENT), J. ACM 23 (1976), 242-251,
C AND THE COMMENTS IN MPPIGL.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1), Q, TS
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (5, 12)
      I2 = 3*T + 9
      I3 = I2 + T + 2
      IF (X(1).NE.0) GO TO 10
      Y(1) = 0
      RETURN
   10 CALL MPSTR (X, R(I3))
      IE = IABS(X(2))
      IF (IE.LE.2) CALL MPCMR (X, RX)
      Q = 1
C REDUCE ARGUMENT IF NECESSARY BEFORE USING SERIES
   20 IF (R(I3+1).LT.0) GO TO 30
      IF ((R(I3+1).EQ.0).AND.((2*(R(I3+2)+1)).LE.B)) GO TO 30
      Q = 2*Q
      CALL MPMUL (R(I3), R(I3), Y)
      CALL MPADDI (Y, 1, Y)
      CALL MPSQRT (Y, Y)
      CALL MPADDI (Y, 1, Y)
      CALL MPDIV (R(I3), Y, R(I3))
      GO TO 20
C USE POWER SERIES NOW ARGUMENT IN (-0.5, 0.5)
   30 CALL MPSTR (R(I3), Y)
      CALL MPMUL (R(I3), R(I3), R(I2))
      I = 1
      TS = T
C SERIES LOOP.  REDUCE T IF POSSIBLE.
   40 T = TS + 2 + R(I3+1)
      IF (T.LE.2) GO TO 50
      T = MIN0 (T, TS)
      CALL MPMUL (R(I3), R(I2), R(I3))
      CALL MPMULQ (R(I3), -I, I+2, R(I3))
      I = I + 2
      T = TS
      CALL MPADD (Y, R(I3), Y)
      IF (R(I3).NE.0) GO TO 40
C RESTORE T, CORRECT FOR ARGUMENT REDUCTION, AND EXIT
   50 T = TS
      CALL MPMULI (Y, Q, Y)
C CHECK THAT RELATIVE ERROR LESS THAN 0.01 UNLESS EXPONENT
C OF X IS LARGE (WHEN ATAN MIGHT NOT WORK)
      IF (IE.GT.2) RETURN
      CALL MPCMR (Y, RY)
      IF (ABS(RY - ATAN(RX)) .LT. (0.01*ABS(RY))) RETURN
      WRITE (LUN, 60)
C THE FOLLOWING MESSAGE MAY INDICATE THAT B**(T-1) IS TOO SMALL.
   60 FORMAT (51H *** ERROR OCCURRED IN MPATAN, RESULT INCORRECT ***)
      CALL MPERR
      RETURN
      END
      FUNCTION MPBASA (X)                                               MP009553
C RETURNS THE MP BASE (FIRST WORD IN COMMON).
C X IS A DUMMY MP ARGUMENT.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      MPBASA = B
      RETURN
      END
      SUBROUTINE MPBASB (I, X)                                          MP009573
C SETS THE MP BASE (FIRST WORD OF COMMON) TO I.
C I SHOULD BE AN INTEGER SUCH THAT I .GE. 2
C AND (8*I*I-1) IS REPRESENTABLE AS A SINGLE-PRECISION INTEGER.
C X IS A DUMMY MP ARGUMENT (AUGMENT EXPECTS ONE).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C SET BASE TO I, THEN CHECK VALIDITY
      B = I
      CALL MPCHK (1, 4)
      RETURN
      END
      SUBROUTINE MPBERN (N, P, X)                                       MP009620
C COMPUTES THE BERNOULLI NUMBERS B2 = 1/6, B4 = -1/30,
C B6 = 1/42, B8 = -1/30, B10 = 5/66, B12 = -691/2730, ETC.,
C DEFINED BY THE GENERATING FUNCTION Y/(EXP(Y)-1).
C N AND P ARE SINGLE-PRECISION INTEGERS, WITH 2*P .GE. T+2.
C X SHOULD BE A ONE-DIMENSIONAL INTEGER ARRAY OF DIMENSION AT
C LEAST P*N.  THE BERNOULLI NUMBERS B2, B4, ... , B(2N) ARE
C RETURNED IN PACKED FORMAT IN X, WITH B(2J) IN LOCATIONS
C X((J-1)*P+1), ... , X(P*J).  THUS, TO GET B(2J) IN USUAL
C MP FORMAT IN Y, ONE SHOULD CALL MPUNPK (X(IX), Y) AFTER
C CALLING MPBERN, WHERE IX = (J-1)*P+1.
C
C ALTERNATIVELY (SIMPLER BUT NONSTANDARD) -
C X MAY BE A TWO-DIMENSIONAL INTEGER ARRAY DECLARED WITH
C DIMENSION (P, N1), WHERE N1 .GE. N AND 2*P .GE. T+2.
C THEN B2, B4, ... , B(2N) ARE RETURNED IN PACKED FORMAT IN
C X, WITH B(2J) IN X(1,J), ... , X(P,J).  THUS, TO GET
C B(2J) IN USUAL MP FORMAT IN Y ONE SHOULD
C CALL MPUNPK (X(1, J), Y) AFTER CALLING MPBERN.
C
C THE WELL-KNOWN RECURRENCE IS UNSTABLE (LOSING ABOUT 2J BITS
C OF RELATIVE ACCURACY IN THE COMPUTED B(2J)), SO WE USE A
C DIFFERENT RECURRENCE DERIVED BY EQUATING COEFFICIENTS IN
C (EXP(Y)+1)*(2Y/(EXP(2Y)-1)) = 2*(Y/(EXP(Y)-1)).  THE RELATION
C B(2J) = -2*((-1)**J)*FACTORIAL(2J)*ZETA(2J)/((2PI)**(2J))
C IS USED IF ZETA(2J) IS EQUAL TO 1 TO WORKING ACCURACY.
C A DIFFERENT METHOD IS GIVEN BY KNUTH AND BUCKHOLTZ IN
C MATH. COMP. 21 (1967), 663-688.
C THE RELATIVE ERROR IN B(2J) IS O((J**2)*(B**(1-T))).
C TIME IS O(T*(MIN(N, T)**2) + N*M(T)), SPACE = 8T+18.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), P, X(1)
      IF (N.LE.0) RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (8, 18)
      IF ((2*P).GE.(T+2)) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (38H *** P TOO SMALL IN CALL TO MPBERN ***)
      CALL MPERR
      RETURN
   20 I2 = 4*T + 11
      I3 = I2 + T + 2
      I4 = I3 + T + 2
      I5 = I4 + T + 2
      B2 = MAX0 (B/2, 32)
C COMPUTE UPPER LIMIT FOR RECURRENCE RELATION METHOD.
      N2 = MIN0 (N, INT(0.5E0+ALOG(FLOAT(B))*FLOAT(T)/ALOG(4E0)))
C SET ALL RESULTS TO ZERO
      DO 30 I = 1, N2
      IX = (I-1)*P + 2
   30 X(IX) = 0
      CALL MPCQM (1, 8, R(I2))
      CALL MPSTR (R(I2), R(I3))
      CALL MPCIM (-1, R(I5))
C MAIN LOOP TO GENERATE SCALED BERNOULLI NUMBERS
      DO 70 J = 1, N2
      CALL MPDIVI (R(I3), 2, R(I3))
      CALL MPDIVI (R(I5), 4, R(I5))
      CALL MPADDI (R(I5), 1, R(I4))
      CALL MPDIV (R(I3), R(I4), R(I3))
      IX = (J-1)*P + 1
      CALL MPPACK (R(I3), X(IX))
      IF (J.GE.N2) GO TO 80
      CALL MPDIVI (R(I2), 4*J-2, R(I2))
      CALL MPDIVI (R(I2), 4*J+4, R(I2))
      CALL MPSTR (R(I2), R(I3))
      DO 60 I = 1, J
      IX = (I-1)*P + 1
      CALL MPUNPK (X(IX), R(I4))
      IF ((J-I).GE.B2) GO TO 40
      CALL MPDIVI (R(I4), 8*(2*(J-I)+1)*(J+1-I), R(I4))
      GO TO 50
C HERE SPLIT UP IN CASE WOULD GET OVERFLOW IN ONE CALL TO MPDIVI
   40 CALL MPDIVI (R(I4), 4*(J+1-I), R(I4))
      CALL MPDIVI (R(I4), 4*(J-I)+2, R(I4))
   50 CALL MPPACK (R(I4), X(IX))
   60 CALL MPSUB (R(I3), R(I4), R(I3))
   70 CONTINUE
C NOW UNSCALE RESULTS
   80 CALL MPCIM (1, R(I2))
      IF (N2.LE.1) GO TO 100
      I = N2
   90 CALL MPMULI (R(I2), (4*(N2-I)+4), R(I2))
      CALL MPMULI (R(I2), (4*(N2-I)+2), R(I2))
      I = I - 1
      IX = (I-1)*P + 1
      CALL MPUNPK (X(IX), R(I4))
      CALL MPMUL (R(I2), R(I4), R(I4))
      CALL MPPACK (R(I4), X(IX))
      IF (I.GT.1) GO TO 90
C NOW HAVE B(2J)/FACTORIAL(2J) IN X
      CALL MPCIM (1, R(I2))
  100 DO 110 I = 1, N2
      CALL MPMULI (R(I2), 2*I-1, R(I2))
      CALL MPMULI (R(I2), 2*I, R(I2))
      IX = (I-1)*P + 1
      CALL MPUNPK (X(IX), R(I4))
      CALL MPMUL (R(I2), R(I4), R(I4))
  110 CALL MPPACK (R(I4), X(IX))
C RETURN IF FINISHED
      IF (N.LE.N2) RETURN
C ELSE COMPUTE REMAINING NUMBERS
      CALL MPPI (R(I3))
      CALL MPPWR (R(I3), -2, R(I3))
      CALL MPDIVI (R(I3), -4, R(I3))
      N2 = N2 + 1
      DO 120 I = N2, N
      CALL MPMUL (R(I4), R(I3), R(I4))
      CALL MPMULI (R(I4), 2*I-1, R(I4))
      CALL MPMULI (R(I4), 2*I, R(I4))
      IX = (I-1)*P + 1
  120 CALL MPPACK (R(I4), X(IX))
      RETURN
      END
      SUBROUTINE MPBESJ (X, NU, Y)                                      MP010770
C RETURNS Y = J(NU,X), THE FIRST-KIND BESSEL FUNCTION OF ORDER NU,
C FOR SMALL INTEGER NU, MP X AND Y.  ABS(NU) MUST BE
C .LE. MAX(B, 64).  METHOD IS HANKELS ASYMPTOTIC EXPANSION IF
C ABS(X) LARGE, THE POWER SERIES IF ABS(X) SMALL, AND THE
C BACKWARD RECURRENCE METHOD OTHERWISE.
C RESULTS FOR NEGATIVE ARGUMENTS ARE DEFINED BY
C J(-NU,X) = J(NU,-X) = ((-1)**NU)*J(NU,X).
C ERROR COULD BE INDUCED BY O(B**(1-T)) PERTURBATIONS
C IN X AND Y.  TIME IS O(T.M(T)) FOR FIXED X AND NU, INCREASES
C AS X AND NU INCREASE, UNLESS X LARGE ENOUGH FOR ASYMPTOTIC
C SERIES TO BE USED.   SPACE = 14T+156
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(2), Y(1), TS, TS2, TM, ERROR
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (14, 156)
      TS = T
      B2 = MAX0 (B, 64)
      NUA = IABS(NU)
C CHECK THAT ABS(NU) IS .LE. MAX(B, 64).  THIS RESTRICTION
C ENSURES THAT 4*(NU**2) IS REPRESENTABLE AS AN INTEGER.
      IF (NUA.LE.B2) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (44H *** ABS(NU) TOO LARGE IN CALL TO MPBESJ ***)
      GO TO 120
C CHECK FOR X ZERO
   20 IF (X(1).NE.0) GO TO 30
C J(NU,0) = 0 IF NU .EQ. 0, 1 IF NU .NE. 0
      Y(1) = 0
      IF (NU.EQ.0) CALL MPCIM (1, Y)
      RETURN
C SEE IF ABS(X) SO LARGE THAT NO ACCURACY POSSIBLE
   30 IF (X(2).GE.T) GO TO 100
C X NONZERO SO TRY HANKEL ASYMPTOTIC SERIES WITH ONE GUARD DIGIT
      I2 = 11*T + 36
      CALL MPCLR (R(I2), T+1)
      CALL MPSTR (X, R(I2))
      T = T + 1
      CALL MPHANK (R(I2), NUA, R(I2), ERROR)
      T = TS
      CALL MPSTR (R(I2), Y)
C RETURN IF ASYMPTOTIC SERIES WAS ACCURATE ENOUGH
      IF (ERROR.EQ.0) GO TO 90
C ASYMPTOTIC SERIES INADEQUATE HERE, SO USE POWER SERIES
C MAY NEED TO INCREASE T LATER SO PREPARE FOR THIS
C MAX ALLOWABLE T IS APPROXIMATELY DOUBLE
      TM = 2*T + 20
      I2 = 4*TM + 11
      I3 = I2 + TM + 2
      I4 = I3 + TM + 2
C ZERO TRAILING DIGITS OF R(I2) AND R(I4)
      CALL MPCLR (R(I2), TM)
      CALL MPCLR (R(I4), TM)
      TS2 = T
C NO APPRECIABLE CANCELLATION IN POWER SERIES IF ABS(X) .LT. 1
      IF (X(2).LE.0) GO TO 40
C SHOULD BE OK TO CONVERT TO REAL HERE AS X NOT TOO LARGE OR SMALL.
      CALL MPCMR (X, RX)
C ESTIMATE NUMBER OF DIGITS REQUIRED TO COMPENSATE FOR CANCELLATION
      TS2 = MAX0 (TS, T + 1 + INT((ABS(RX)+(FLOAT(NUA)+0.5E0)*
     $    ALOG(0.5E0*ABS(RX)))/ALOG(FLOAT(B))))
C IF NEED MORE DIGITS THAN SPACE ALLOWS FOR POWER SERIES THEN
C USE RECURRENCE METHOD INSTEAD
      IF (TS2.GT.TM) GO TO 130
C PREPARE FOR POWER SERIES LOOP
   40 CALL MPDIVI (X, 2, R(I4))
      CALL MPPWR (R(I4), NUA, R(I4))
      CALL MPGAMQ (NUA+1, 1, R(I3))
      CALL MPDIV (R(I4), R(I3), R(I4))
      CALL MPMUL (X, X, R(I2))
      CALL MPDIVI (R(I2), -4, R(I2))
      T = TS2
      CALL MPSTR (R(I4), R(I3))
      IE = R(I3+1)
      K = 0
C POWER SERIES LOOP, REDUCE T IF POSSIBLE
   50 T = MIN0 (TS2, TS2 + 2 + R(I4+1) - IE)
      IF (T.LT.2) GO TO 80
      CALL MPMUL (R(I2), R(I4), R(I4))
      K = K + 1
C MAY NEED TO SPLIT UP CALL TO MPDIVI
      IF (K.GT.B2) GO TO 60
      CALL MPDIVI (R(I4), K*(K+NUA), R(I4))
      GO TO 70
C HERE IT IS SPLIT UP TO AVOID OVERFLOW
   60 CALL MPDIVI (R(I4), K, R(I4))
      CALL MPDIVI (R(I4), K+NUA, R(I4))
C RESTORE T FOR ADDITION
   70 T = TS2
      CALL MPADD (R(I3), R(I4), R(I3))
      IF ((R(I4).NE.0).AND.(R(I4+1).GE.(R(I3+1)-TS))) GO TO 50
C RESTORE T AND MOVE FINAL RESULT
   80 T = TS
      CALL MPSTR (R(I3), Y)
C CORRECT SIGN IF NU ODD AND NEGATIVE
   90 IF ((NU.LT.0).AND.(MOD(NUA,2).NE.0)) Y(1) = -Y(1)
      RETURN
C HERE ABS(X) SO LARGE THAT NO SIGNIFICANT DIGITS COULD BE
C GUARANTEED
  100 WRITE (LUN, 110)
  110 FORMAT (43H *** ABS(X) TOO LARGE IN CALL TO MPBESJ ***)
  120 CALL MPERR
      T = TS
      Y(1) = 0
      RETURN
C HERE USE BACKWARD RECURRENCE METHOD WITH TWO GUARD DIGITS
  130 CALL MPABS (X, R(I4))
      T = T + 2
      CALL MPBES2 (R(I4), NUA, R(I3))
C CORRECT SIGN IF NUA ODD
      IF (MOD (NUA,2) .NE. 0) R(I3) = X(1)*R(I3)
      GO TO 80
      END
      SUBROUTINE MPBES2 (X, NU, Y)                                      MP011906
C USES THE BACKWARD RECURRENCE METHOD TO EVALUATE Y = J(NU,X),
C WHERE X AND Y ARE MP NUMBERS, NU (THE INDEX) IS AN INTEGER,
C AND J IS THE BESSEL FUNCTION OF THE FIRST KIND.  ASSUMES THAT
C 0 .LE. NU .LE. MAX(B,64) AND X .GT. 0. ALSO ASSUMED THAT X
C CAN BE CONVERTED TO REAL WITHOUT FLOATING-POINT OVERFLOW OR
C UNDERFLOW.  FOR NORMALIZATION THE IDENTITY
C J(0,X) + 2*J(2,X) + 2*J(4,X) + ... = 1  IS USED.
C CALLED BY MPBESJ AND NOT RECOMMENDED FOR INDEPENDENT USE.
C SPACE = 8T+18
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (8, 18)
C CHECK LEGALITY OF NU AND X
      IF ((NU.GE.0).AND.(NU.LE.MAX0(B,64)).AND.(X(1).EQ.1)) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (50H *** NU .LT. 0 OR NU TOO LARGE OR X .LE. 0 IN CALL,
     $        14H TO MPBES2 ***)
      CALL MPERR
      Y(1) = 0
      RETURN
C ASSUME CONVERSION TO REAL IS POSSIBLE WITHOUT OVERFLOW (TRUE
C WHEN CALLED BY MPBESJ ELSE MPHANK OR POWER SERIES WOULD BE USED).
   20 CALL MPCMR (X, RX)
C COMPUTE STARTING POINT NU1 FOR BACKWARD RECURRENCE
      FLNU = FLOAT (MAX0 (1, NU))
      RY  = AMAX1 (1E0, ALOG(2E0*FLNU/RX) - 1E0)
C 1.35914 IS E/2 ROUNDED DOWN, 1.35915 IS E/2 ROUNDED UP
      RY = (FLNU*RY + 0.5E0*FLOAT(T)*ALOG(FLOAT(B)))/(1.35914E0*RX)
      RY = AMAX1 (2E0, RY)
      RT = RY
C ITERATE AN EVEN NUMBER OF TIMES TO OVERESTIMATE NU1
      DO 30 I = 1, 4
   30 RT = AMAX1 (2E0, RY/ALOG(RT))
      NU1 = 2 + INT(1.35915E0*RX*RT)
      I2 = 3*T + 9
      I3 = I2 + T + 2
      I4 = I3 + T + 2
      I5 = I4 + T + 2
      I6 = I5 + T + 2
      CALL MPCIM (MOD(NU1+1,2), R(I6))
      CALL MPREC (X, R(I2))
      CALL MPMULI (R(I2), 2, R(I2))
      R(I3) = 0
      CALL MPCIM (1, R(I4))
C BACKWARD RECURRENCE LOOP
   40 CALL MPMUL (R(I4), R(I2), R(I5))
      CALL MPMULI (R(I5), NU1, R(I5))
      CALL MPSUB (R(I5), R(I3), R(I5))
      NU1 = NU1 - 1
C FASTER TO INTERCHANGE POINTERS THAN MP NUMBERS
      I3S = I3
      I3 = I4
      I4 = I5
      I5 = I3S
      IF (MOD(NU1,2) .NE. 0) GO TO 50
C NU1 EVEN SO UPDATE NORMALIZING SUM
      IF (NU1.EQ.0) CALL MPMULI (R(I6), 2, R(I6))
      CALL MPADD (R(I6), R(I4), R(I6))
C SAVE UNNORMALIZED RESULT IF NU1 .EQ. NU
   50 IF (NU1.EQ.NU) CALL MPSTR (R(I4), Y)
      IF (NU1.GT.0) GO TO 40
C NORMALIZE RESULT AND RETURN
      CALL MPDIV (Y, R(I6), Y)
      RETURN
      END
      SUBROUTINE MPCAM (A, X)                                           MP012493
C CONVERTS THE HOLLERITH STRING A TO AN MP NUMBER X.
C A CAN BE A STRING OF DIGITS ACCEPTABLE TO ROUTINE MPIN
C AND TERMINATED BY A DOLLAR ($), E.G. 7H-5.367$,
C OR ONE OF THE FOLLOWING SPECIAL STRINGS -
C            EPS  (MP MACHINE-PRECISION, SEE MPEPS),
C            EUL  (EULERS CONSTANT 0.5772..., SEE MPEUL),
C            MAXR (LARGEST VALID MP NUMBER, SEE MPMAXR),
C            MINR (SMALLEST POSTIVE MP NUMBER, SEE MPMINR),
C            PI   (PI = 3.14..., SEE MPPI).
C ONLY THE FIRST TWO CHARACTERS OF THESE STRINGS ARE CHECKED.
C SPACE REQUIRED IS NO MORE THAN 5*T+L+14, WHERE L IS THE
C NUMBER OF CHARACTERS IN THE STRING A (EXCLUDING $).
C IF SPACE IS LESS 3*T+L+11 THE STRING A WILL EFFECTIVELY BE TRUNCATED
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), A(1), X(1), ERROR, C(6), D(2)
      DATA C(1) /1HA/, C(2) /1HE/, C(3) /1HI/
      DATA C(4) /1HM/, C(5) /1HP/, C(6) /1HU/
C UNPACK FIRST 2 CHARACTERS OF A
      CALL MPUPK (A, D, 2, N)
      IF (N.NE.2) GO TO 10
C SET X TO ZERO AFTER SAVING A(1) IN CASE A AND X COINCIDE
      I = A(1)
      X(1) = 0
C CHECK FOR SPECIAL STRINGS
      IF ((D(1).EQ.C(2)).AND.(D(2).EQ.C(5))) CALL MPEPS (X)
      IF ((D(1).EQ.C(2)).AND.(D(2).EQ.C(6))) CALL MPEUL (X)
      IF ((D(1).EQ.C(4)).AND.(D(2).EQ.C(1))) CALL MPMAXR (X)
      IF ((D(1).EQ.C(4)).AND.(D(2).EQ.C(3))) CALL MPMINR (X)
      IF ((D(1).EQ.C(5)).AND.(D(2).EQ.C(3))) CALL MPPI (X)
C RETURN IF X NONZERO (SO ONE OF ABOVE TESTS SUCCEEDED)
      IF (X(1).NE.0) RETURN
C RESTORE A(1) AND UNPACK, THEN CALL MPIN TO DECODE.
      A(1) = I
   10 I2 = 3*T + 12
      CALL MPUPK (A, R(I2), MXR+1-I2, N)
      CALL MPIN (R(I2), X, N, ERROR)
      IF (ERROR.EQ.0) RETURN
      WRITE (LUN, 20)
   20 FORMAT (53H *** ERROR IN HOLLERITH CONSTANT IN CALL TO MPCAM ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPCDM (DX, Z)                                          MP012590
C CONVERTS DOUBLE-PRECISION NUMBER DX TO MULTIPLE-PRECISION Z.
C SOME NUMBERS WILL NOT CONVERT EXACTLY ON MACHINES
C WITH BASE OTHER THAN TWO, FOUR OR SIXTEEN.
C THIS ROUTINE IS NOT CALLED BY ANY OTHER ROUTINE IN MP,
C SO MAY BE OMITTED IF DOUBLE-PRECISION IS NOT AVAILABLE.
      DOUBLE PRECISION DB, DJ, DX, DBLE
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), Z(1), RS, RE, TP
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      I2 = T + 4
C CHECK SIGN
      IF (DX) 20, 10, 30
C IF DX = 0D0 RETURN 0
   10 Z(1) = 0
      RETURN
C DX .LT. 0D0
   20 RS = -1
      DJ = -DX
      GO TO 40
C DX .GT. 0D0
   30 RS = 1
      DJ = DX
   40 IE = 0
   50 IF (DJ.LT.1D0) GO TO 60
C INCREASE IE AND DIVIDE DJ BY 16.
      IE = IE + 1
      DJ = 0.0625D0*DJ
      GO TO 50
   60 IF (DJ.GE.0.0625D0) GO TO 70
      IE = IE - 1
      DJ = 16D0*DJ
      GO TO 60
C NOW DJ IS DY DIVIDED BY SUITABLE POWER OF 16
C SET EXPONENT TO 0
   70 RE = 0
C DB = DFLOAT(B) IS NOT ANSI STANDARD SO USE FLOAT AND DBLE
      DB = DBLE(FLOAT(B))
C CONVERSION LOOP (ASSUME DOUBLE-PRECISION OPS. EXACT)
      DO 80 I = 1, I2
      DJ = DB*DJ
      R(I) = IDINT(DJ)
   80 DJ = DJ - DBLE(FLOAT(R(I)))
C NORMALIZE RESULT
      CALL MPNZR (RS, RE, Z, 0)
      IB = MAX0(7*B*B, 32767)/16
      TP = 1
C NOW MULTIPLY BY 16**IE
      IF (IE) 90, 130, 110
   90 K = -IE
      DO 100 I = 1, K
      TP = 16*TP
      IF ((TP.LE.IB).AND.(TP.NE.B).AND.(I.LT.K)) GO TO 100
      CALL MPDIVI (Z, TP, Z)
      TP = 1
  100 CONTINUE
      RETURN
  110 DO 120 I = 1, IE
      TP = 16*TP
      IF ((TP.LE.IB).AND.(TP.NE.B).AND.(I.LT.IE)) GO TO 120
      CALL MPMULI (Z, TP, Z)
      TP = 1
  120 CONTINUE
  130 RETURN
      END
      SUBROUTINE MPCHK (I, J)                                           MP013260
C CHECKS LEGALITY OF B, T, M, MXR AND LUN WHICH SHOULD BE SET
C IN COMMON.
C THE CONDITION ON MXR (THE DIMENSION OF R IN COMMON) IS THAT
C MXR .GE. (I*T + J)
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1)
C FIRST CHECK THAT LUN IN RANGE 1 TO 99, IF NOT PRINT ERROR
C MESSAGE ON LOGICAL UNIT 6.
      IF ((0.LT.LUN).AND.(LUN.LT.100)) GO TO 20
      WRITE (6, 10) LUN
   10 FORMAT (10H *** LUN =, I10, 26H ILLEGAL IN CALL TO MPCHK,,
     $ 49H PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***)
      LUN = 6
      CALL MPERR
C NOW CHECK LEGALITY OF B, T AND M
   20 IF (B.GT.1) GO TO 40
      WRITE (LUN, 30) B
   30 FORMAT (8H *** B =, I10, 26H ILLEGAL IN CALL TO MPCHK,/
     $ 49H PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***)
      CALL MPERR
   40 IF (T.GT.1) GO TO 60
      WRITE (LUN, 50) T
   50 FORMAT (8H *** T =, I10, 26H ILLEGAL IN CALL TO MPCHK,/
     $ 49H PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***)
      CALL MPERR
   60 IF (M.GT.T) GO TO 80
      WRITE (LUN, 70)
   70 FORMAT (31H *** M .LE. T IN CALL TO MPCHK,/
     $ 49H PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***)
      CALL MPERR
C 8*B*B-1 SHOULD BE REPRESENTABLE, IF NOT WILL OVERFLOW
C AND MAY BECOME NEGATIVE, SO CHECK FOR THIS
   80 IB = 4*B*B - 1
      IF ((IB.GT.0).AND.((2*IB+1).GT.0)) GO TO 100
      WRITE (LUN, 90)
   90 FORMAT (37H *** B TOO LARGE IN CALL TO MPCHK ***)
      CALL MPERR
C CHECK THAT SPACE IN COMMON IS SUFFICIENT
  100 MX = I*T + J
      IF (MXR.GE.MX) RETURN
C HERE COMMON IS TOO SMALL, SO GIVE ERROR MESSAGE.
      WRITE (LUN, 110) I, J, MX, MXR, T
  110 FORMAT (51H *** MXR TOO SMALL OR NOT SET TO DIM(R) BEFORE CALL,
     $ 21H TO AN MP ROUTINE *** /
     $ 27H *** MXR SHOULD BE AT LEAST, I3, 4H*T +, I4, 2H =, I6, 5H  ***
     $ / 19H *** ACTUALLY MXR =, I10, 9H, AND T =, I10, 5H  ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPCIM (IX, Z)                                          MP013770
C CONVERTS INTEGER IX TO MULTIPLE-PRECISION Z.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), Z(2)
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      N = IX
      IF (N) 20, 10, 30
   10 Z(1) = 0
      RETURN
   20 N = -N
      Z(1) = -1
      GO TO 40
   30 Z(1) = 1
C SET EXPONENT TO T
   40 Z(2) = T
C CLEAR FRACTION
      DO 50 I = 2, T
   50 Z(I+1) = 0
C INSERT N
      Z(T+2) = N
C NORMALIZE BY CALLING MPMUL2
      CALL MPMUL2 (Z, 1, Z, 1)
      RETURN
      END
      SUBROUTINE MPCLR (X, N)                                           MP014040
C SETS X(T+3), ... , X(N+2) TO ZERO, USEFUL
C IF PRECISION IS GOING TO BE INCREASED.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      IF (N.LE.T) RETURN
      I2 = T + 3
      I3 = N + 2
      DO 10 I = I2, I3
   10 X(I) = 0
      RETURN
      END
      SUBROUTINE MPCMD (X, DZ)                                          MP014170
C CONVERTS MULTIPLE-PRECISION X TO DOUBLE-PRECISION DZ.
C ASSUMES X IS IN ALLOWABLE RANGE FOR DOUBLE-PRECISION
C NUMBERS.   THERE IS SOME LOSS OF ACCURACY IF THE
C EXPONENT IS LARGE.
      DOUBLE PRECISION DB, DZ, DZ2, DBLE, DLOG, DABS
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), TM
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      DZ = 0D0
      IF (X(1).EQ.0) RETURN
C DB = DFLOAT(B) IS NOT ANSI STANDARD, SO USE FLOAT AND DBLE
      DB = DBLE(FLOAT(B))
      DO 10 I = 1, T
      DZ = DB*DZ + DBLE(FLOAT(X(I+2)))
      TM = I
C CHECK IF FULL DOUBLE-PRECISION ACCURACY ATTAINED
      DZ2 = DZ + 1D0
C TEST BELOW NOT ALWAYS EQUIVALENT TO - IF (DZ2.LE.DZ) GO TO 20,
C FOR EXAMPLE ON CYBER 76.
      IF ((DZ2-DZ).LE.0D0) GO TO 20
   10 CONTINUE
C NOW ALLOW FOR EXPONENT
   20 DZ = DZ*(DB**(X(2)-TM))
C CHECK REASONABLENESS OF RESULT.
      IF (DZ.LE.0D0) GO TO 30
C LHS SHOULD BE .LE. 0.5 BUT ALLOW FOR SOME ERROR IN DLOG
      IF (DABS(DBLE(FLOAT(X(2)))-(DLOG(DZ)/
     $    DLOG(DBLE(FLOAT(B)))+0.5D0)).GT.0.6D0) GO TO 30
      IF (X(1).LT.0) DZ = -DZ
      RETURN
C FOLLOWING MESSAGE INDICATES THAT X IS TOO LARGE OR SMALL -
C TRY USING MPCMDE INSTEAD.
   30 WRITE (LUN, 40)
   40 FORMAT (48H *** FLOATING-POINT OVER/UNDER-FLOW IN MPCMD ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPCMDE (X, N, DX)                                      MP014570
C RETURNS INTEGER N AND DOUBLE-PRECISION DX SUCH THAT MP
C X = DX*10**N (APPROXIMATELY), WHERE 1 .LE. ABS(DX) .LT. 10
C UNLESS DX = 0.    SPACE = 6T+14
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      DOUBLE PRECISION DX, DBLE, DABS
      IF (X(1).NE.0) GO TO 10
      N = 0
      DX = 0D0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (6, 14)
      I2 = 5*T + 13
      CALL MPCMEF (X, N, R(I2))
      CALL MPCMD (R(I2), DX)
      IF (DABS(DX).LT.10D0) RETURN
C HERE DX WAS ROUNDED UP TO TEN
      N = N + 1
      DX = DBLE(FLOAT(R(I2)))
      RETURN
      END
      SUBROUTINE MPCMEF (X, N, Y)                                       MP014800
C GIVEN MP X, RETURNS INTEGER N AND MP Y SUCH THAT X = (10**N)*Y
C AND 1 .LE. ABS(Y) .LT. 10 (UNLESS X .EQ. 0, WHEN N .EQ. 0 AND
C Y .EQ. 0).
C IT IS ASSUMED THAT X IS NOT SO LARGE OR SMALL THAT N OVERFLOWS.
C SPACE = 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(2), TEN
C FOR OCTAL OUTPUT CHANGE 10 TO 8 BELOW, ETC.
      DATA TEN /10/
C CHECK FOR X ZERO
      IF (X(1).NE.0) GO TO 10
      N = 0
      Y(1) = 0
      RETURN
C X NONZERO, CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 12)
      CALL MPSTR (X, Y)
      N = 0
      I2 = 4*T + 11
C LOOP UP TO FOUR TIMES (USUALLY ONE IS SUFFICIENT)
      DO 20 J = 1, 4
      IY = Y(2)
      Y(2) = 0
      CALL MPCMR (Y, RY)
      Y(2) = IY
C ESTIMATE LOG10 (ABS(Y))
      RLY = (FLOAT(IY)*ALOG(FLOAT(B))+ALOG(ABS(RY)))/ALOG(FLOAT(TEN))
      N1 = INT (RLY)
C CHECK IF N1 OBVIOUSLY OVERFLOWED
      IF (ABS(RLY-FLOAT(N1)) .GT. 16E0) GO TO 30
C FOLLOWING AVOIDS POSSIBILITY OF R(I2) OVERFLOWING BELOW
      IF ((J.EQ.1).AND.(IABS(N1).GT.(M/4))) N1 = N1/2
C LEAVE J LOOP IF N1 SMALL
      IF (IABS(N1).LE.2) GO TO 50
C DIVIDE BY TEN**N1
      N = N + N1
      CALL MPCIM (TEN, R(I2))
      CALL MPPWR (R(I2), IABS(N1), R(I2))
      IF (R(I2).EQ.0) GO TO 30
      IF (N1.GT.0) CALL MPDIV (Y, R(I2), Y)
      IF (N1.LT.0) CALL MPMUL (R(I2), Y, Y)
   20 CONTINUE
   30 WRITE (LUN, 40)
   40 FORMAT (48H *** ERROR OCCURRED IN MPCMEF, PROBABLY OVERFLOW,
     $  29H CAUSED BY LARGE EXPONENT ***)
      CALL MPERR
      RETURN
   50 IF (Y(1).EQ.0) GO TO 30
C LOOP DIVIDING BY TEN UNTIL ABS(Y) .LT. 1
   60 IF (Y(2).LE.0) GO TO 80
      N = N + 1
      CALL MPDIVI (Y, TEN, Y)
      GO TO 60
C LOOP MULTIPLYING BY TEN UNTIL ABS(Y) .GE. 1
   70 IF (Y(2).GT.0) GO TO 90
   80 N = N - 1
      CALL MPMULI (Y, TEN, Y)
      GO TO 70
C CHECK FOR POSSIBILITY THAT ROUNDING UP WAS TO TEN
   90 IY = Y(1)
      Y(1) = 1
      IF (MPCMPI (Y, TEN) .LT. 0) GO TO 100
C IT WAS, SO SET Y TO 1 AND ADD ONE TO EXPONENT
      CALL MPCIM (1, Y)
      N = N + 1
C RESTORE SIGN OF Y AND RETURN
  100 Y(1) = IY
      RETURN
      END
      SUBROUTINE MPCMF (X, Y)                                           MP015510
C FOR MP X AND Y, RETURNS FRACTIONAL PART OF X IN Y,
C I.E., Y = X - INTEGER PART OF X (TRUNCATED TOWARDS 0).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1), X2, XS
      IF (X(1).NE.0) GO TO 20
C RETURN 0 IF X = 0
   10 Y(1) = 0
      RETURN
   20 X2 = X(2)
C RETURN 0 IF EXPONENT SO LARGE THAT NO FRACTIONAL PART
      IF (X2.GE.T) GO TO 10
C IF EXPONENT NOT POSITIVE CAN RETURN X
      IF (X2.GT.0) GO TO 30
      CALL MPSTR (X, Y)
      RETURN
C CLEAR ACCUMULATOR
   30 DO 40 I = 1, X2
   40 R(I) = 0
      IL = X2 + 1
C MOVE FRACTIONAL PART OF X TO ACCUMULATOR
      DO 50 I = IL, T
   50 R(I) = X(I+2)
      DO 60 I = 1, 4
      IP = I + T
   60 R(IP) = 0
      XS = X(1)
C NORMALIZE RESULT AND RETURN
      CALL MPNZR (XS, X2, Y, 1)
      RETURN
      END
      SUBROUTINE MPCMI (X, IZ)                                          MP015830
C CONVERTS MULTIPLE-PRECISION X TO INTEGER IZ,
C ASSUMING THAT X NOT TOO LARGE (ELSE USE MPCMIM).
C X IS TRUNCATED TOWARDS ZERO.
C IF INT(X)IS TOO LARGE TO BE REPRESENTED AS A SINGLE-
C PRECISION INTEGER, IZ IS RETURNED AS ZERO.  THE USER
C MAY CHECK FOR THIS POSSIBILITY BY TESTING IF
C ((X(1).NE.0).AND.(X(2).GT.0).AND.(IZ.EQ.0)) IS TRUE ON
C RETURN FROM MPCMI.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), XS, X2
      XS = X(1)
      IZ = 0
      IF (XS.EQ.0) RETURN
      IF (X(2).LE.0) RETURN
      X2 = X(2)
      DO 10 I = 1, X2
      IZS = IZ
      IZ = B*IZ
      IF (I.LE.T) IZ = IZ + X(I+2)
C CHECK FOR SIGNS OF INTEGER OVERFLOW
      IF ((IZ.LE.0).OR.(IZ.LE.IZS)) GO TO 30
   10 CONTINUE
C CHECK THAT RESULT IS CORRECT (AN UNDETECTED OVERFLOW MAY
C HAVE OCCURRED).
      J = IZ
      DO 20 I = 1, X2
      J1 = J/B
      K = X2 + 1 - I
      KX = 0
      IF (K.LE.T) KX = X(K+2)
      IF (KX.NE.(J - B*J1)) GO TO 30
   20 J = J1
      IF (J.NE.0) GO TO 30
C RESULT CORRECT SO RESTORE SIGN AND RETURN
      IZ = XS*IZ
      RETURN
C HERE OVERFLOW OCCURRED (OR X WAS UNNORMALIZED), SO
C RETURN ZERO.
   30 IZ = 0
      RETURN
      END
      SUBROUTINE MPCMIM (X, Y)                                          MP016260
C RETURNS Y = INTEGER PART OF X (TRUNCATED TOWARDS 0), FOR MP X AND Y.
C USE IF Y TOO LARGE TO BE REPRESENTABLE AS A SINGLE-PRECISION INTEGER.
C (ELSE COULD USE MPCMI).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(2)
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      CALL MPSTR (X, Y)
      IF (Y(1).EQ.0) RETURN
      IL = Y(2) + 1
C IF EXPONENT LARGE ENOUGH RETURN Y = X
      IF (IL.GT.T) RETURN
C IF EXPONENT SMALL ENOUGH RETURN ZERO
      IF (IL.GT.1) GO TO 10
      Y(1) = 0
      RETURN
C SET FRACTION TO ZERO
   10 DO 20 I = IL, T
   20 Y(I+2) = 0
      RETURN
      END
      FUNCTION MPCMPA (X, Y)                                            MP016490
C COMPARES ABS(X) WITH ABS(Y) FOR MP X AND Y,
C RETURNING +1 IF ABS(X) .GT. ABS(Y),
C           -1 IF ABS(X) .LT. ABS(Y),
C AND        0 IF ABS(X) .EQ. ABS(Y)
      INTEGER X(1), Y(1), XS, YS
      XS = X(1)
      X(1) = IABS(XS)
      YS = Y(1)
      Y(1) = IABS(YS)
      MPCMPA = MPCOMP (X, Y)
      X(1) = XS
      Y(1) = YS
      RETURN
      END
      FUNCTION MPCMPI (X, I)                                            MP016650
C COMPARES MP NUMBER X WITH INTEGER I, RETURNING
C     +1 IF X .GT. I,
C      0 IF X .EQ. I,
C     -1 IF X .LT. I
C DIMENSION OF R IN COMMON AT LEAST 2T+6
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(6), X(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (2, 6)
C CONVERT I TO MULTIPLE-PRECISION AND COMPARE
      CALL MPCIM (I, R(T+5))
      MPCMPI = MPCOMP (X, R(T+5))
      RETURN
      END
      FUNCTION MPCMPR (X, RI)                                           MP016810
C COMPARES MP NUMBER X WITH REAL NUMBER RI, RETURNING
C     +1 IF X .GT. RI,
C      0 IF X .EQ. RI,
C     -1 IF X .LT. RI
C DIMENSION OF R IN COMMON AT LEAST 2T+6
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(6), X(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (2, 6)
C CONVERT RI TO MULTIPLE-PRECISION AND COMPARE
      CALL MPCRM (RI, R(T+5))
      MPCMPR = MPCOMP (X, R(T+5))
      RETURN
      END
      SUBROUTINE MPCMR (X, RZ)                                          MP016970
C CONVERTS MULTIPLE-PRECISION X TO SINGLE-PRECISION RZ.
C ASSUMES X IN ALLOWABLE RANGE.  THERE IS SOME LOSS OF
C ACCURACY IF THE EXPONENT IS LARGE.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), TM
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      RZ = 0E0
      IF (X(1).EQ.0) RETURN
      RB = FLOAT(B)
      DO 10 I = 1, T
      RZ = RB*RZ + FLOAT(X(I+2))
      TM = I
C CHECK IF FULL SINGLE-PRECISION ACCURACY ATTAINED
      RZ2 = RZ + 1E0
      IF (RZ2.LE.RZ) GO TO 20
   10 CONTINUE
C NOW ALLOW FOR EXPONENT
   20 RZ = RZ*(RB**(X(2)-TM))
C CHECK REASONABLENESS OF RESULT
      IF (RZ.LE.0E0) GO TO 30
C LHS SHOULD BE .LE. 0.5, BUT ALLOW FOR SOME ERROR IN ALOG
      IF (ABS(FLOAT(X(2))-(ALOG(RZ)/ALOG(FLOAT(B))+0.5E0)).GT.0.6E0)
     $    GO TO 30
      IF (X(1).LT.0) RZ = -RZ
      RETURN
C FOLLOWING MESSAGE INDICATES THAT X IS TOO LARGE OR SMALL -
C TRY USING MPCMRE INSTEAD.
   30 WRITE (LUN, 40)
   40 FORMAT (48H *** FLOATING-POINT OVER/UNDER-FLOW IN MPCMR ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPCMRE (X, N, RX)                                      MP017320
C RETURNS INTEGER N AND SINGLE-PRECISION RX SUCH THAT MP
C X = RX*10**N (APPROXIMATELY), WHERE 1 .LE. ABS(RX) .LT. 10
C UNLESS RX = 0.    SPACE = 6T+14
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      IF (X(1).NE.0) GO TO 10
      N = 0
      RX = 0E0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (6, 14)
      I2 = 5*T + 13
      CALL MPCMEF (X, N, R(I2))
      CALL MPCMR (R(I2), RX)
      IF (ABS(RX).LT.10E0) RETURN
C HERE RX WAS ROUNDED UP TO TEN
      N = N + 1
      RX = FLOAT(R(I2))
      RETURN
      END
      FUNCTION MPCOMP (X, Y)                                            MP017540
C COMPARES THE MULTIPLE-PRECISION NUMBERS X AND Y,
C RETURNING +1 IF X .GT. Y,
C           -1 IF X .LT. Y,
C AND        0 IF X .EQ. Y.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), T2
      IF (X(1) - Y(1)) 10, 30, 20
C X .LT. Y
   10 MPCOMP = -1
      RETURN
C X .GT. Y
   20 MPCOMP = 1
      RETURN
C SIGN(X) = SIGN(Y), SEE IF ZERO
   30 IF (X(1).NE.0) GO TO 40
C X = Y = 0
      MPCOMP = 0
      RETURN
C HAVE TO COMPARE EXPONENTS AND FRACTIONS
   40 T2 = T + 2
      DO 50 I = 2, T2
      IF (X(I) - Y(I)) 60, 50, 70
   50 CONTINUE
C NUMBERS EQUAL
      MPCOMP = 0
      RETURN
C ABS(X) .LT. ABS(Y)
   60 MPCOMP = -X(1)
      RETURN
C ABS(X) .GT. ABS(Y)
   70 MPCOMP = X(1)
      RETURN
      END
      SUBROUTINE MPCOS (X, Y)                                           MP017890
C RETURNS Y = COS(X) FOR MP X AND Y, USING MPSIN AND MPSIN1.
C DIMENSION OF R IN COMMON AT LEAST 5T+12.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
      IF (X(1).NE.0) GO TO 10
C COS(0) = 1
      CALL MPCIM (1, Y)
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 12)
      I2 = 3*T + 12
C SEE IF ABS(X) .LE. 1
      CALL MPABS (X, Y)
      IF (MPCMPI (Y, 1) .LE. 0) GO TO 20
C HERE ABS(X) .GT. 1 SO USE COS(X) = SIN(PI/2 - ABS(X)),
C COMPUTING PI/2 WITH ONE GUARD DIGIT.
      T = T + 1
      CALL MPPI (R(I2))
      CALL MPDIVI (R(I2), 2, R(I2))
      T = T - 1
      CALL MPSUB (R(I2), Y, Y)
      CALL MPSIN (Y, Y)
      RETURN
C HERE ABS(X) .LE. 1 SO USE POWER SERIES
   20 CALL MPSIN1 (Y, Y, 0)
      RETURN
      END
      SUBROUTINE MPCOSH (X, Y)                                          MP018180
C RETURNS Y = COSH(X) FOR MP NUMBERS X AND Y, X NOT TOO LARGE.
C USES MPEXP, DIMENSION OF R IN COMMON AT LEAST 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
      IF (X(1).NE.0) GO TO 10
C COSH(0) = 1
      CALL MPCIM (1, Y)
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 12)
      I2 = 4*T + 11
      CALL MPABS (X, R(I2))
C IF ABS(X) TOO LARGE MPEXP WILL PRINT ERROR MESSAGE
C INCREASE M TO AVOID OVERFLOW WHEN COSH(X) REPRESENTABLE
      M = M + 2
      CALL MPEXP (R(I2), R(I2))
      CALL MPREC (R(I2), Y)
      CALL MPADD (R(I2), Y, Y)
C RESTORE M.  IF RESULT OVERFLOWS OR UNDERFLOWS, MPDIVI WILL
C ACT ACCORDINGLY.
      M = M - 2
      CALL MPDIVI (Y, 2, Y)
      RETURN
      END
      SUBROUTINE MPCQM (I, J, Q)                                        MP018440
C CONVERTS THE RATIONAL NUMBER I/J TO MULTIPLE PRECISION Q.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), Q(1)
      I1 = I
      J1 = J
      CALL MPGCD (I1, J1)
      IF (J1) 30, 10, 40
   10 WRITE (LUN, 20)
   20 FORMAT (31H *** J = 0 IN CALL TO MPCQM ***)
      CALL MPERR
      Q(1) = 0
      RETURN
   30 I1 = -I1
      J1 = -J1
   40 CALL MPCIM (I1, Q)
      IF (J1.NE.1) CALL MPDIVI (Q, J1, Q)
      RETURN
      END
      SUBROUTINE MPCRM (RX, Z)                                          MP018640
C CONVERTS SINGLE-PRECISION NUMBER RX TO MULTIPLE-PRECISION Z.
C SOME NUMBERS WILL NOT CONVERT EXACTLY ON MACHINES
C WITH BASE OTHER THAN TWO, FOUR OR SIXTEEN.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), Z(1), RE, RS, TP
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      I2 = T + 4
C CHECK SIGN
      IF (RX) 20, 10, 30
C IF RX = 0E0 RETURN 0
   10 Z(1) = 0
      RETURN
C RX .LT. 0E0
   20 RS = -1
      RJ = -RX
      GO TO 40
C RX .GT. 0E0
   30 RS = 1
      RJ = RX
   40 IE = 0
   50 IF (RJ.LT.1E0) GO TO 60
C INCREASE IE AND DIVIDE RJ BY 16.
      IE = IE + 1
      RJ = 0.0625E0*RJ
      GO TO 50
   60 IF (RJ.GE.0.0625E0) GO TO 70
      IE = IE - 1
      RJ = 16E0*RJ
      GO TO 60
C NOW RJ IS DY DIVIDED BY SUITABLE POWER OF 16.
C SET EXPONENT TO 0
   70 RE = 0
      RB = FLOAT(B)
C CONVERSION LOOP (ASSUME SINGLE-PRECISION OPS. EXACT)
      DO 80 I = 1, I2
      RJ = RB*RJ
      R(I) = INT(RJ)
   80 RJ = RJ - FLOAT(R(I))
C NORMALIZE RESULT
      CALL MPNZR (RS, RE, Z, 0)
      IB = MAX0(7*B*B, 32767)/16
      TP = 1
C NOW MULTIPLY BY 16**IE
      IF (IE) 90, 130, 110
   90 K = -IE
      DO 100 I = 1, K
      TP = 16*TP
      IF ((TP.LE.IB).AND.(TP.NE.B).AND.(I.LT.K)) GO TO 100
      CALL MPDIVI (Z, TP, Z)
      TP = 1
  100 CONTINUE
      RETURN
  110 DO 120 I = 1, IE
      TP = 16*TP
      IF ((TP.LE.IB).AND.(TP.NE.B).AND.(I.LT.IE)) GO TO 120
      CALL MPMULI (Z, TP, Z)
      TP = 1
  120 CONTINUE
  130 RETURN
      END
      SUBROUTINE MPDAW (X, Y)                                           MP019266
C RETURNS Y = DAWSONS INTEGRAL (X)
C           = EXP(-X**2)*(INTEGRAL FROM 0 TO X OF EXP(U**2)DU),
C FOR MP X AND Y.    SPACE = 5T+17.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(1), Y(1), XS, TS
      XS = X(1)
      IF (XS.NE.0) GO TO 10
C DAW(0) = 0
      Y(1) = 0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 17)
      I2 = 2*T + 9
      I3 = I2 + T + 3
      I4 = I3 + T + 3
      B2 = 2*MAX0(B, 64)
C WORK WITH ABS(X)
      CALL MPABS (X, R(I4))
C TRY ASYMPTOTIC SERIES
      CALL MPERF3 (R(I4), R(I4), 1, IER)
      IF (IER.NE.0) GO TO 20
      CALL MPSTR (R(I4), Y)
      Y(1) = XS*Y(1)
      RETURN
C ASYMPTOTIC SERIES NOT ACCURATE ENOUGH SO USE POWER SERIES
C WITH ONE GUARD DIGIT.
   20 CALL MPCLR (R(I4), T+1)
      CALL MPSTR (X, R(I4))
      T = T + 1
      CALL MPMUL (R(I4), R(I4), R(I4))
      CALL MPNEG (R(I4), R(I4))
      CALL MPEXP (R(I4), R(I4))
      T = T - 1
      CALL MPCLR (R(I2), T+1)
      CALL MPSTR (X, R(I2))
      T = T + 1
      CALL MPMUL (R(I2), R(I4), R(I3))
      CALL MPMUL (R(I2), R(I2), R(I4))
      CALL MPSTR (R(I3), R(I2))
      I = 0
      TS = T
C POWER SERIES LOOP, REDUCE T IF POSSIBLE
   30 T = TS + 2 + R(I3+1) - R(I2+1)
      IF (T.LE.2) GO TO 60
      T = MIN0 (T, TS)
      I = I + 1
      CALL MPMUL (R(I4), R(I3), R(I3))
C SEE IF NEXT CALL TO MPMULQ HAS TO BE SPLIT UP
      IF (I.GE.B2) GO TO 40
      CALL MPMULQ (R(I3), 2*I-1, I*(2*I+1), R(I3))
      GO TO 50
   40 CALL MPMULQ (R(I3), 2*I-1, 2*I+1, R(I3))
      CALL MPDIVI (R(I3), I, R(I3))
C RESTORE T FOR ADDITION
   50 T = TS
      CALL MPADD (R(I2), R(I3), R(I2))
      IF (R(I3).NE.0) GO TO 30
C RESTORE T AND RETURN
   60 T = TS - 1
      CALL MPSTR (R(I2), Y)
      RETURN
      END
      FUNCTION MPDGA (X, N)                                             MP019743
C RETURNS THE N-TH DIGIT OF THE MP NUMBER X FOR 1 .LE. N .LE. T.
C RETURNS ZERO IF X IS ZERO OR N .LE. 0 OR N .GT. T.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      MPDGA = 0
      IF ((X(1).NE.0).AND.(N.GT.0).AND.(N.LE.T)) MPDGA = X(N+2)
      RETURN
      END
      SUBROUTINE MPDGB (I, X, N)                                        MP019783
C SETS THE N-TH DIGIT OF THE MP NUMBER X TO I.
C N MUST BE IN THE RANGE 1 .LE. N .LE T,
C I MUST BE IN THE RANGE 0 .LE. I .LT. B
C (AND I .NE. 0 IF N .EQ. 1).
C THE SIGN AND EXPONENT OF X ARE UNCHANGED.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      IF ((N.GT.0).AND.(N.LE.T)) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (48H *** DIGIT POSITION ILLEGAL IN CALL TO MPDGB ***)
      GO TO 40
   20 IF ((I.GE.0).AND.(I.LT.B).AND.((I+N).GT.1)) GO TO 50
      WRITE (LUN, 30)
   30 FORMAT (45H *** DIGIT VALUE ILLEGAL IN CALL TO MPDGB ***)
   40 CALL MPERR
      RETURN
   50 X(N+2) = I
      RETURN
      END
      FUNCTION MPDIGA (X)                                               MP019843
C RETURNS THE NUMBER OF MP DIGITS (SECOND WORD IN COMMON).
C X IS A DUMMY MP ARGUMENT.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      MPDIGA = T
      RETURN
      END
      SUBROUTINE MPDIGB (I, X)                                          MP019863
C SETS THE NUMBER OF MP DIGITS (SECOND WORD OF COMMON) TO I.
C I SHOULD BE AN INTEGER SUCH THAT I .GE. 2
C X IS A DUMMY MP ARGUMENT (AUGMENT EXPECTS ONE).
C WARNING *** MP NUMBERS MUST BE DECLARED AS INTEGER ARRAYS OF
C         *** DIMENSION AT LEAST I+2. MPDIGB DOES NOT CHECK THIS.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C SET DIGITS TO I, THEN CHECK VALIDITY
      T = I
      CALL MPCHK (1, 4)
      RETURN
      END
      SUBROUTINE MPDIV (X, Y, Z)                                        MP019910
C SETS Z = X/Y, FOR MP X, Y AND Z.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 4T+10
C (BUT Z(1) MAY BE R(3T+9)).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), Z(3)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
C CHECK FOR DIVISION BY ZERO
      IF (Y(1).NE.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (52H *** ATTEMPTED DIVISION BY ZERO IN CALL TO MPDIV ***)
      CALL MPERR
      Z(1) = 0
      RETURN
C SPACE USED BY MPREC IS 4T+10 WORDS, BUT CAN OVERLAP SLIGHTLY.
   20 I2 = 3*T + 9
C CHECK FOR X = 0
      IF (X(1).NE.0) GO TO 30
      Z(1) = 0
      RETURN
C INCREASE M TO AVOID OVERFLOW IN MPREC
   30 M = M + 2
C FORM RECIPROCAL OF Y
      CALL MPREC (Y, R(I2))
C SET EXPONENT OF R(I2) TO ZERO TO AVOID OVERFLOW IN MPMUL
      IE = R(I2+1)
      R(I2+1) = 0
      I = R(I2+2)
C MULTIPLY BY X
      CALL MPMUL (X, R(I2), Z)
      IZ3 = Z(3)
      CALL MPEXT (I, IZ3, Z)
C RESTORE M, CORRECT EXPONENT AND RETURN
      M = M - 2
      Z(2) = Z(2) + IE
      IF (Z(2).GE.(-M)) GO TO 40
C UNDERFLOW HERE
      CALL MPUNFL (Z)
      RETURN
   40 IF (Z(2).LE.M) RETURN
C OVERFLOW HERE
      WRITE (LUN, 50)
   50 FORMAT (35H *** OVERFLOW OCCURRED IN MPDIV ***)
      CALL MPOVFL (Z)
      RETURN
      END
      SUBROUTINE MPDIVI (X, IY, Z)                                      MP020390
C DIVIDES MP X BY THE SINGLE-PRECISION INTEGER IY GIVING MP Z.
C THIS IS MUCH FASTER THAN DIVISION BY AN MP NUMBER.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Z(2), RS, RE, R1, C, C2, B2
      RS = X(1)
      J = IY
      IF (J) 30, 10, 40
   10 WRITE (LUN, 20)
   20 FORMAT (53H *** ATTEMPTED DIVISION BY ZERO IN CALL TO MPDIVI ***)
      GO TO 230
   30 J = -J
      RS = -RS
   40 RE = X(2)
C CHECK FOR ZERO DIVIDEND
      IF (RS.EQ.0) GO TO 120
C CHECK FOR DIVISION BY B
      IF (J.NE.B) GO TO 50
      CALL MPSTR (X, Z)
      IF (RE.LE.(-M)) GO TO 240
      Z(1) = RS
      Z(2) = RE - 1
      RETURN
C CHECK FOR DIVISION BY 1 OR -1
   50 IF (J.NE.1) GO TO 60
      CALL MPSTR (X, Z)
      Z(1) = RS
      RETURN
   60 C = 0
      I2 = T + 4
      I = 0
C IF J*B NOT REPRESENTABLE AS AN INTEGER HAVE TO SIMULATE
C LONG DIVISION.   ASSUME AT LEAST 16-BIT WORD.
      B2 = MAX0 (8*B, 32767/B)
      IF (J.GE.B2) GO TO 130
C LOOK FOR FIRST NONZERO DIGIT IN QUOTIENT
   70 I = I + 1
      C = B*C
      IF (I.LE.T) C = C + X(I+2)
      R1 = C/J
      IF (R1) 210, 70, 80
C ADJUST EXPONENT AND GET T+4 DIGITS IN QUOTIENT
   80 RE = RE + 1 - I
      R(1) = R1
      C = B*(C - J*R1)
      KH = 2
      IF (I.GE.T) GO TO 100
      KH = 1 + T - I
      DO 90 K = 2, KH
      I = I + 1
      C = C + X(I+2)
      R(K) = C/J
   90 C = B*(C - J*R(K))
      IF (C.LT.0) GO TO 210
      KH = KH + 1
  100 DO 110 K = KH, I2
      R(K) = C/J
  110 C = B*(C - J*R(K))
      IF (C.LT.0) GO TO 210
C NORMALIZE AND ROUND RESULT
  120 CALL MPNZR (RS, RE, Z, 0)
      RETURN
C HERE NEED SIMULATED DOUBLE-PRECISION DIVISION
  130 C2 = 0
      J1 = J/B
      J2 = J - J1*B
      J11 = J1 + 1
C LOOK FOR FIRST NONZERO DIGIT
  140 I = I + 1
      C = B*C + C2
      C2 = 0
      IF (I.LE.T) C2 = X(I+2)
      IF (C-J1) 140, 150, 160
  150 IF (C2.LT.J2) GO TO 140
C COMPUTE T+4 QUOTIENT DIGITS
  160 RE = RE + 1 - I
      K = 1
      GO TO 180
C MAIN LOOP FOR LARGE ABS(IY) CASE
  170 K = K + 1
      IF (K.GT.I2) GO TO 120
      I = I + 1
C GET APPROXIMATE QUOTIENT FIRST
  180 IR = C/J11
C NOW REDUCE SO OVERFLOW DOES NOT OCCUR
      IQ = C - IR*J1
      IF (IQ.LT.B2) GO TO 190
C HERE IQ*B WOULD POSSIBLY OVERFLOW SO INCREASE IR
      IR = IR + 1
      IQ = IQ - J1
  190 IQ = IQ*B - IR*J2
      IF (IQ.GE.0) GO TO 200
C HERE IQ NEGATIVE SO IR WAS TOO LARGE
      IR = IR - 1
      IQ = IQ + J
  200 IF (I.LE.T) IQ = IQ + X(I+2)
      IQJ = IQ/J
C R(K) = QUOTIENT, C = REMAINDER
      R(K) = IQJ + IR
      C = IQ - J*IQJ
      IF (C.GE.0) GO TO 170
C CARRY NEGATIVE SO OVERFLOW MUST HAVE OCCURRED
  210 CALL MPCHK (1, 4)
      WRITE (LUN, 220)
  220 FORMAT (48H *** INTEGER OVERFLOW IN MPDIVI, B TOO LARGE ***)
  230 CALL MPERR
      Z(1) = 0
      RETURN
C UNDERFLOW HERE
  240 CALL MPUNFL(Z)
      RETURN
      END
      SUBROUTINE MPDUMP (X)                                             MP021520
C DUMPS OUT THE MP NUMBER X (SIGN, EXPONENT, FRACTION DIGITS),
C USEFUL FOR DEBUGGING PURPOSES.
C EMBEDDED BLANKS SHOULD BE INTERPRETED AS ZEROS. (THEY COULD BE
C AVOIDED BY USING J INSTEAD OF I FORMAT, BUT THIS IS NONSTANDARD.)
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), T2
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      IF (X(1).NE.0) GO TO 10
C IF X = 0 JUST WRITE SIGN AS REMAINDER UNDEFINED
      WRITE (LUN, 20) X(1)
      RETURN
   10 T2 = T + 2
      IF (B.LE.10) WRITE (LUN, 20) (X(I), I = 1, T2)
      IF ((B.GT.10).AND.(B.LE.100)) WRITE (LUN, 30) (X(I), I = 1, T2)
      IF ((B.GT.100).AND.(B.LE.1000)) WRITE (LUN, 40) (X(I), I = 1, T2)
      IF (B.GT.1000) WRITE (LUN, 50) (X(I), I = 1, T2)
C ASSUME RECORDS OF UP TO 79 CHARACTERS OK ON UNIT LUN
   20 FORMAT (1X, I2, I12, 4X, 60I1 / (19X, 60I1))
   30 FORMAT (1X, I2, I12, 4X, 30I2 / (19X, 30I2))
   40 FORMAT (1X, I2, I12, 4X, 20I3 / (19X, 20I3))
   50 FORMAT (1X, I2, I16, 4X, 8I7 / (23X, 8I7))
      RETURN
      END
      SUBROUTINE MPEI (X, Y)                                            MP021776
C RETURNS Y = EI(X) = -E1(-X)
C           = (PRINCIPAL VALUE INTEGRAL FROM -INFINITY TO X OF
C              EXP(U)/U DU),
C FOR MP NUMBERS X AND Y,
C USING THE POWER SERIES FOR SMALL ABS(X), THE ASYMPTOTIC SERIES FOR
C LARGE ABS(X), AND THE CONTINUED FRACTION FOR INTERMEDIATE NEGATIVE
C X.  RELATIVE ERROR IN Y IS SMALL EXCEPT IF X IS VERY CLOSE TO THE
C ZERO  0.37250741078136663446... OF EI(X),
C AND THEN THE ABSOLUTE ERROR IN Y IS O(B**(1-T)).
C IN ANY CASE THE ERROR IN Y COULD BE INDUCED BY AN
C O(B**(1-T)) RELATIVE PERTURBATION IN X.
C TIME IS O(T.M(T)), SPACE = 10T+38.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(1), Y(2), TD, TS, TM, TM2, TS1, TS2, XS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (10, 38)
      XS = X(1)
      IF (XS.NE.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (31H *** X ZERO IN CALL TO MPEI ***)
C EI(0) IS UNDEFINED, TREAT AS OVERFLOW
      CALL MPOVFL (Y)
      RETURN
C SAVE T ETC
   20 TS =T
      TM2 = (11*T+19)/10
      TM = (6*T+9)/5
      B2 = 2*MAX0(B, 64)
      I = 0
C ALLOW SPACE FOR MPEUL
      I2 = 5*TM2 + 19
      I3 = I2 + TM + 2
      I4 = I3 + TM + 2
C CLEAR DIGITS OF R(I3)
      CALL MPCLR (R(I3), T+1)
      CALL MPABS (X, R(I3))
      RB = FLOAT(B)
      RT = FLOAT(T)*ALOG(RB)
C SEE IF ABS(X) LARGE ENOUGH TO USE ASYMPTOTIC SERIES
      IF (MPCMPR (R(I3), RT) .GT. 0) GO TO 80
C SEE IF X NEGATIVE AND CONTINUED FRACTION USABLE
C THE CONSTANT 0.1 WAS DETERMINED EMPIRICALLY AND MAY BE
C DECREASED (BUT NOT INCREASED) IF DESIRED.
      IF ((XS.LT.0).AND.(MPCMPR(R(I3),0.1*RT).GT.0)) GO TO 110
C USE POWER SERIES HERE, BUT NEED TO INCREASE T IF X NEGATIVE
C TO COMPENSATE FOR CANCELLATION.
      T = T + 1
      TS1 = T
      TS2 = T
      IF (XS.GT.0) GO TO 30
      CALL MPCMR (R(I3), RAX)
C IF X NEGATIVE RESULT ABOUT B**(-TD) AND TERMS ABOUT B**TD SO
C NEED UP TO 2*TD EXTRA DIGITS TO COMPENSATE FOR CANCELLATION
      TD = 1 + INT(RAX/ALOG(RB))
      TS2 = T + TD
      TS1 = MIN0 (TS2 + TD, TM)
      TS2 = MIN0 (TS2, TM2)
C CLEAR TRAILING DIGITS OF R(I2) AND R(I3)
      CALL MPCLR (R(I2), TS1)
      CALL MPCLR (R(I3), TS1)
C USE TS2 DIGITS FOR LN AND EULERS CONSTANT COMPUTATION
      T = TS2
C NOW PREPARE TO SUM POWER SERIES
   30 CALL MPLN (R(I3), R(I4))
C MPEI COULD BE SPEEDED UP IF EULERS CONSTANT WERE
C PRECOMPUTED AND SAVED
      CALL MPEUL (R(I2))
      CALL MPADD (R(I2), R(I4), R(I2))
C NOW USE TS1 DIGITS FOR SUMMING POWER SERIES
      T = TS1
C RESTORE SIGN OF R(I3)
      R(I3) = XS
      CALL MPADD (R(I2), R(I3), R(I2))
      CALL MPSTR (R(I3), R(I4))
C LOOP TO SUM POWER SERIES, REDUCING T IF POSSIBLE
   40 IF (XS.GE.0) T = TS1 + 2 + R(I4+1) - R(I2+1)
      IF ((XS.LT.0).AND.(R(I4+1).LE.0)) T = TS2 + 2 + R(I4+1)
      T = MIN0 (T, TS1)
      IF (T.LE.2) GO TO 70
      CALL MPMUL (R(I3), R(I4), R(I4))
      I = I + 1
C IF I LARGE NEED TO SPLIT UP CALL TO MPMULQ
      IF (I.GE.B2) GO TO 50
      CALL MPMULQ (R(I4), I, (I+1)**2, R(I4))
      GO TO 60
   50 CALL MPMULQ (R(I4), I, I+1, R(I4))
      CALL MPDIVI (R(I4), I+1, R(I4))
C RESTORE T FOR ADDITION
   60 T = TS1
      CALL MPADD (R(I2), R(I4), R(I2))
      IF (R(I4).NE.0) GO TO 40
C RESTORE T, MOVE RESULT AND RETURN
   70 T = TS
      CALL MPSTR (R(I2), Y)
      RETURN
C HERE WE CAN USE ASYMPTOTIC SERIES, AND NO NEED TO INCREASE T
   80 CALL MPREC (X, R(I3))
C MPEXP GIVES ERROR MESSAGE IF X TOO LARGE HERE
      CALL MPEXP (X, Y)
      IF (Y(1).EQ.0) RETURN
      CALL MPMUL (Y, R(I3), Y)
      CALL MPSTR (Y, R(I2))
C LOOP TO SUM ASYMPTOTIC SERIES, REDUCING T IF POSSIBLE
   90 T = TS + 2 + R(I2+1) - Y(2)
C RETURN IF TERMS SMALL ENOUGH TO BE NEGLIGIBLE
      IF (T.LE.2) GO TO 100
      T = MIN0 (T, TS)
      CALL MPSTR (R(I2), R(I4))
      CALL MPMUL (R(I2), R(I3), R(I2))
      I = I + 1
      CALL MPMULI (R(I2), I, R(I2))
C RETURN IF TERMS INCREASING
      IF (MPCMPA (R(I2), R(I4)) .GE. 0) GO TO 100
C RESTORE T FOR ADDITION
      T = TS
      CALL MPADD (Y, R(I2), Y)
      IF (R(I2).NE.0) GO TO 90
C RESTORE T AND RETURN
  100 T = TS
      RETURN
C HERE 0.1*T*LN(B) .LT. -X .LE T*LN(B), SO USE CONTINUED FRACTION.
  110 CALL MPCMR (X, RX)
      C = -RX
      CP = 1.0
      K = T
      J = 0
C USE FORWARD RECURRENCE WITH SINGLE-PRECISION TO FIND HOW
C MANY TERMS NEEDED FOR FULL MP ACCURACY.
  120 J = J + 1
      CP = CP + C/FLOAT(J)
      C = C - RX*CP
C SCALE TO AVOID OVERFLOW
  130 IF (CP.LT.RB) GO TO 120
      C = C/RB
      CP = CP/RB
      K = K - 2
      IF (K.GT.0) GO TO 130
C NOW USE BACKWARD RECURRENCE WITH MP ARITHMETIC
      CALL MPCIM (1, R(I2))
  140 CALL MPDIVI (R(I3), J, R(I4))
      CALL MPADD (R(I2), R(I4), R(I2))
      CALL MPMUL (X, R(I2), R(I4))
      CALL MPSUB (R(I3), R(I4), R(I3))
C SCALE TO AVOID OVERFLOW
      R(I2+1) = R(I2+1) - R(I3+1)
      R(I3+1) = 0
      J = J - 1
      IF (J.GT.0) GO TO 140
      CALL MPDIV (R(I2), R(I3), R(I2))
      CALL MPEXP (X, Y)
      CALL MPMUL (Y, R(I2), Y)
      Y(1) = -Y(1)
      RETURN
      END
      SUBROUTINE MPEPS (X)                                              MP022956
C SETS MP X TO THE (MULTIPLE-PRECISION) MACHINE PRECISION,
C THAT IS THE SMALLEST POSITIVE NUMBER X SUCH THAT
C THE COMPUTED VALUE OF 1 + X IS GREATER THAN 1
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3)
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
C SET SIGN AND EXPONENT
      X(1) = 1
      X(2) = 1 - T
C SET FRACTION DIGITS TO ZERO
      DO 10 I = 2, T
   10 X(I+2) = 0
C SEE IF BASE IS EVEN OR ODD
      IF (MOD (B, 2) .NE. 0) GO TO 20
C EVEN BASE HERE SO X = 0.5*B**(1-T)
      X(3) = B/2
      RETURN
C ODD BASE HERE, SET X SLIGHTLY LARGER (NOTE THAT
C FOUR GUARD DIGITS ARE USED IN MPADD)
   20 I = 1
   30 X(I+2) = B/2
      I = I + 1
      IF (I.LT.MIN0(4, T)) GO TO 30
      X(I+2) = B/2 + 1
      RETURN
      END
      LOGICAL FUNCTION MPEQ (X, Y)                                      MP023223
C RETURNS LOGICAL VALUE OF (X .EQ. Y) FOR MP X AND Y.
      INTEGER X(1), Y(1)
      MPEQ = (MPCOMP(X,Y) .EQ. 0)
      RETURN
      END
      SUBROUTINE MPERF (X, Y)                                           MP023250
C RETURNS Y = ERF(X) = SQRT(4/PI)*(INTEGRAL FROM 0 TO X OF
C EXP(-U**2) DU) FOR MP X AND Y,  SPACE = 5T+12.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), TS, XS
      XS = X(1)
      IF (XS.NE.0) GO TO 10
C ERF(0) = 0
      Y(1) = 0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 12)
      I2 = 4*T + 11
      CALL MPABS (X, R(I2))
      IF (MPCMPR (R(I2), SQRT(FLOAT(T)*ALOG(FLOAT(B)))) .LT. 0)
     $    GO TO 20
C HERE ABS(X) SO LARGE THAT ERF(X) = +-1 TO FULL ACCURACY
      CALL MPCIM (XS, Y)
      RETURN
C HERE SAVE T AND TRY USING ASYMPTOTIC SERIES
   20 TS = T
      CALL MPCMR (X, RX)
C CAN POSSIBLY REDUCE T TEMPORARILY
      IF (B.GE.64) T = MIN0(TS, MAX0(4, T - INT(RX*RX/ALOG(FLOAT(B)))))
C TRY ASYMPTOTIC SERIES
      CALL MPERF3 (R(I2), R(I2), 0, IER)
      IF (IER.EQ.0) GO TO 30
C ASYMPTOTIC SERIES INSUFFICIENT, SO USE POWER SERIES
C WITH ONE GUARD DIGIT.  SPACE REQUIRED BY MPERF2 IS
C ONLY 3(T+1)+8 = 3T+11 AS ABS(X) SMALL
      T = TS
      CALL MPCLR (R(I2), T+1)
      CALL MPSTR (X, R(I2))
      T = T + 1
      CALL MPERF2 (R(I2), R(I2))
C NOW RESTORE T
      T = TS
C IN BOTH CASES MULTIPLY BY SQRT(4/PI)*EXP(-X**2)
   30 CALL MPMUL (X, X, Y)
      Y(1) = -Y(1)
      CALL MPEXP(Y, Y)
      CALL MPMUL (Y, R(I2), R(I2))
      CALL MPPI (Y)
      CALL MPROOT (Y, -2, Y)
      CALL MPMUL (Y, R(I2), R(I2))
      IF (IER.EQ.0) GO TO 40
C USED POWER SERIES SO CAN RETURN
      CALL MPMULI (R(I2), 2, Y)
      RETURN
C USED ASYMPTOTIC SERIES SO SUBTRACT FROM 1
   40 CALL MPMULI (R(I2), -2, R(I2))
      T = TS
      CALL MPADDI (R(I2), 1, Y)
      Y(1) = XS*Y(1)
      RETURN
      END
      SUBROUTINE MPERFC (X, Y)                                          MP023820
C RETURNS Y = ERFC(X) = 1 - ERF(X) FOR MP NUMBERS X AND Y,
C USING MPERF AND MPERF3.   SPACE = 12T+26
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), TS, TS2
      IF (X(1).GT.0) GO TO 10
C FOR X .LE. 0 NO LOSS OF ACCURACY IN USING ERF(X)
      CALL MPERF (X, Y)
      Y(1) = -Y(1)
      CALL MPADDI (Y, 1, Y)
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (12, 26)
      TS = T
      TS2 = 2*T + 2
      I2 = 5*TS2 + 13
C TRY ASYMPTOTIC SERIES
      CALL MPERF3 (X, R(I2), 0, IER)
      IF (IER.NE.0) GO TO 20
C ASYMPTOTIC SERIES WORKED, SO MULTIPLY BY
C SQRT(4/PI)*EXP(-X**2) AND RETURN
      CALL MPMUL (X, X, Y)
      Y(1) = -Y(1)
      CALL MPEXP (Y, Y)
      CALL MPMUL (Y, R(I2), R(I2))
      CALL MPPI (Y)
      CALL MPROOT (Y, -2, Y)
      CALL MPMUL (Y, R(I2), R(I2))
      CALL MPMULI (R(I2), 2, Y)
      RETURN
C HERE ASYMPTOTIC SERIES INACCURATE SO HAVE TO
C USE MPERF, INCREASING PRECISION TO COMPENSATE FOR
C CANCELLATION.  AN ALTERNATIVE METHOD (POSSIBLY FASTER) IS
C TO USE THE CONTINUED FRACTION FOR EXP(X**2)*ERFC(X).
   20 CALL MPCMR (X, RX)
C CLEAR DIGITS OF R(I2)
      CALL MPCLR (R(I2), TS2)
C MOVE X TO R(I2)
      CALL MPSTR (X, R(I2))
C COMPUTE NEW T FOR MPERF COMPUTATION
      T = MIN0 (TS2, TS + 2 + INT(RX*RX/ALOG(FLOAT(B))))
      CALL MPERF (R(I2), R(I2))
      R(I2) = -R(I2)
      CALL MPADDI (R(I2), 1, R(I2))
C RESTORE T AND MOVE RESULT TO Y
      T = TS
      CALL MPSTR (R(I2), Y)
      RETURN
      END
      SUBROUTINE MPERF2 (X, Y)                                          MP024320
C RETURNS Y = EXP(X**2)*(INTEGRAL FROM 0 TO X OF EXP(-U*U) DU)
C FOR MP NUMBERS X AND Y, USING THE POWER SERIES FOR SMALL X,
C AND MPEXP FOR LARGE X.  SPACE = 5T+12 (OR 3T+8 FOR
C SMALL X).   CALLED BY MPERF.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(2), TS, XS
      IF (X(1).NE.0) GO TO 10
C RETURN 0 IF X .EQ. 0
      Y(1) = 0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (3, 8)
      I2 = T + 5
      I3 = I2 + T + 2
      CALL MPABS (X, R(I3))
      IF (MPCMPR (R(I3), SQRT(FLOAT(T)*ALOG(FLOAT(B)))) .GT. 0)
     $    GO TO 40
C USE THE POWER SERIES HERE
      CALL MPSTR (X, Y)
      CALL MPMUL (X, X, R(I2))
      CALL MPMULI (R(I2), 2, R(I2))
      CALL MPSTR (X, R(I3))
      TS = T
      I = 1
C LOOP TO SUM SERIES, REDUCING T IF POSSIBLE
   20 T = TS + 2 + R(I3+1) - Y(2)
      IF (T.LE.2) GO TO 30
      T = MIN0 (T, TS)
      CALL MPMUL (R(I2), R(I3), R(I3))
      I = I + 2
      CALL MPDIVI (R(I3), I, R(I3))
C RESTORE T FOR ADDITION
      T = TS
      CALL MPADD (Y, R(I3), Y)
      IF (R(I3).NE.0) GO TO 20
C RESTORE T AND RETURN
   30 T = TS
      RETURN
C HERE ABS(X) LARGE, SO INTEGRAL IS +-SQRT(PI/4)
   40 CALL MPCHK (5, 12)
      I4 = 4*T + 11
      CALL MPMUL (X, X, R(I4))
C IF ABS(X) TOO LARGE MPEXP GIVES ERROR MESSAGE
      CALL MPEXP (R(I4), R(I4))
      XS = X(1)
      CALL MPPI (Y)
      CALL MPSQRT (Y, Y)
      CALL MPDIVI (Y, 2*XS, Y)
      CALL MPMUL (Y, R(I4), Y)
      RETURN
      END
      SUBROUTINE MPERF3 (X, Y, IND, ERROR)                              MP024850
C IF IND .EQ. 0, RETURNS Y = EXP(X**2)*(INTEGRAL FROM X TO
C                INFINITY OF EXP(-U**2) DU),
C IF IND .NE. 0, RETURNS Y = EXP(-X**2)*(INTEGRAL FROM 0 TO
C                X OF EXP(U**2) DU),
C IN BOTH CASES USING THE ASYMPTOTIC SERIES.
C X AND Y ARE MP NUMBERS, IND AND ERROR ARE INTEGERS.
C ERROR IS RETURNED AS 0 IF X IS LARGE ENOUGH FOR
C THE ASYMPTOTIC SERIES TO GIVE FULL ACCURACY,
C OTHERWISE ERROR IS RETURNED AS 1 AND Y AS ZERO.
C THE CONDITION ON X FOR ERROR .EQ. 0 IS APPROXIMATELY THAT
C X .GT. SQRT(T*LOG(B)).
C CALLED BY MPERF, MPERFC AND MPDAW, SPACE = 4T+10
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(2), ERROR, TS
      ERROR = 0
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
      TS = T
C CHECK THAT CAN GET AT LEAST T-2 DIGITS ACCURACY
      IF (MPCMPR (X, SQRT(FLOAT(T-2)*ALOG(FLOAT(B)))) .GT. 0)
     $    GO TO 30
C HERE X IS TOO SMALL FOR ASYMPTOTIC SERIES TO GIVE
C FULL ACCURACY, SO RETURN WITH ERROR .EQ. 1
   10 Y(1) = 0
      ERROR = 1
   20 T = TS
      RETURN
   30 CALL MPREC (X, Y)
      I2 = T + 5
      I3 = I2 + T + 2
      CALL MPMUL (Y, Y, R(I2))
      CALL MPDIVI (R(I2), 2, R(I2))
      IF (IND.EQ.0) R(I2) = -R(I2)
      CALL MPDIVI (Y, 2, Y)
      CALL MPSTR (Y, R(I3))
      I = 1
C LOOP TO SUM SERIES, REDUCING T IF POSSIBLE
   40 IE = R(I3+1)
      T = TS + 2 + IE - Y(2)
      IF (T.LE.2) GO TO 20
      T = MIN0 (T, TS)
      CALL MPMUL (R(I2), R(I3), R(I3))
      CALL MPMULI (R(I3), I, R(I3))
      I = I + 2
C RESTORE T FOR ADDITION
      T = TS
C CHECK IF TERMS ARE GETTING LARGER - IF SO X IS TOO
C SMALL FOR ASYMPTOTIC SERIES TO BE ACCURATE
      IF (R(I3+1).GT.IE) GO TO 10
      CALL MPADD (Y, R(I3), Y)
      IF (R(I3).NE.0) GO TO 40
      GO TO 20
      END
      SUBROUTINE MPERR                                                  MP025400
C THIS ROUTINE IS CALLED WHEN A FATAL ERROR CONDITION IS
C ENCOUNTERED, AND AFTER A MESSAGE HAS BEEN WRITTEN ON
C LOGICAL UNIT LUN.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1)
      WRITE (LUN, 10)
   10 FORMAT (42H *** EXECUTION TERMINATED BY CALL TO MPERR,
     $        25H IN MP VERSION 780802 ***)
C AT PRESENT JUST STOP, BUT COULD DUMP B, T, ETC. HERE.
C ACTION COULD EASILY BE CONTROLLED BY A FLAG IN LABELLED COMMON.
C ANSI VERSION USES STOP, UNIVAC 1108 VERSION USES
C RETURN 0 IN ORDER TO GIVE A TRACE-BACK.
C FOR DEBUGGING PURPOSES IT MAY BE USEFUL SIMPLY TO
C RETURN HERE.  MOST MP ROUTINES RETURN WITH RESULT
C ZERO AFTER CALLING MPERR.
      STOP
      END
      SUBROUTINE MPEUL (G)                                              MP025590
C RETURNS MP G = EULERS CONSTANT (GAMMA = 0.57721566...)
C TO ALMOST FULL MULTIPLE-PRECISION ACCURACY.
C THE METHOD IS BASED ON BESSEL FUNCTION IDENTITIES AND WAS
C DISCOVERED BY EDWIN MC MILLAN AND R. BRENT.  IT IS FASTER THAN THE
C METHOD OF SWEENEY (MATH. COMP. 17, 1963, 170) USED IN EARLIER
C VERSIONS OF MPEUL.  TIME O(T**2),  SPACE = 5T+18.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), G(1), B2, TS
C CHECK LEGALITY OF B, T, M ETC
      CALL MPCHK (5, 18)
      B2 = 2*MAX0 (B, 64)
C USE ONE GUARD DIGIT TO GIVE ALMOST FULL-PRECISION RESULT
      TS = T
      T = T + 1
      I2 = T + 6
      I3 = I2 + T + 2
      I4 = I3 + T + 2
      I5 = I4 + T + 2
C COMPUTE N SO TRUNCATION ERROR O(EXP(-4*N)) IS O(B**(-T))
      N = INT(0.25*FLOAT(TS)*ALOG(FLOAT(B))) + 1
      IF (N.LE.B2) N2 = N*N
      CALL MPLNI (N, R(I4))
      R(I4) = -R(I4)
      CALL MPSTR (R(I4), R(I3))
      CALL MPCIM (1, R(I2))
      CALL MPSTR (R(I2), R(I5))
      K = 0
C MAIN LOOP STARTS HERE
   10 K = K + 1
C REDUCE T HERE IF POSSIBLE
      IF (K.GT.N) T = MIN0 (T, T + 1 + R(I2+1) - R(I5+1))
C TEST FOR CONVERGENCE
      IF (T.LT.2) GO TO 40
C SPLIT UP CALLS TO MPMULQ IF NECESSARY
      IF ((N.GT.B2).OR.(K.GT.B2)) GO TO 20
      CALL MPMULQ (R(I2), N2, K*K, R(I2))
      CALL MPMULQ (R(I3), N2, K, R(I3))
      GO TO 30
C HERE CALLS TO MPMULQ ARE SPLIT UP
   20 CALL MPMULQ (R(I2), N, K, R(I2))
      CALL MPMULQ (R(I2), N, K, R(I2))
      CALL MPMULQ (R(I3), N, K, R(I3))
      CALL MPMULI (R(I3), N, R(I3))
   30 CALL MPADD (R(I3), R(I2), R(I3))
      CALL MPDIVI (R(I3), K, R(I3))
C INCREASE T HERE
      T = TS + 1
      CALL MPADD (R(I5), R(I2), R(I5))
      CALL MPADD (R(I4), R(I3), R(I4))
C END OF MAIN LOOP
      IF (R(I2).NE.0) GO TO 10
C RESTORE T AND COMPUTE FINAL QUOTIENT
C R(I4) (EXCEPT LAST DIGIT) WILL BE OVERWRITTEN BY MPREC
   40 T = TS
      CALL MPSTR (R(I4), G)
      T = TS + 1
      CALL MPREC (R(I5), R(I5))
      T = TS
      CALL MPSTR (G, R(I4))
      T = TS + 1
      CALL MPMUL (R(I4), R(I5), R(I4))
      T = TS
      CALL MPSTR (R(I4), G)
C CHECK REASONABLENESS OF RESULT, ASSUMING B AND T LARGE
C ENOUGH TO GIVE ERROR LESS THAN 0.01
      CALL MPCMR (G, RG)
      IF (ABS(RG-0.5772) .LT. 0.01) RETURN
      WRITE (LUN, 50)
C THE FOLLOWING MESSAGE MAY INDICATE THAT
C B**(T-1) IS TOO SMALL.
   50 FORMAT (50H *** ERROR OCCURRED IN MPEUL, RESULT INCORRECT ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPEXP (X, Y)                                           MP026346
C RETURNS Y = EXP(X) FOR MP X AND Y.
C EXP OF INTEGER AND FRACTIONAL PARTS OF X ARE COMPUTED
C SEPARATELY.  SEE ALSO COMMENTS IN MPEXP1.
C TIME IS O(SQRT(T)M(T)).
C DIMENSION OF R MUST BE AT LEAST 4T+10 IN CALLING PROGRAM
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2), TS, TSS, XS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
      I2 = 2*T + 7
      I3 = I2 + T + 2
C CHECK FOR X = 0
      IF (X(1).NE.0) GO TO 10
      CALL MPCIM (1, Y)
      RETURN
C CHECK IF ABS(X) .LT. 1
   10 IF (X(2).GT.0) GO TO 20
C USE MPEXP1 HERE
      CALL MPEXP1 (X, Y)
      CALL MPADDI (Y, 1, Y)
      RETURN
C SEE IF ABS(X) SO LARGE THAT EXP(X) WILL CERTAINLY OVERFLOW
C OR UNDERFLOW.  1.01 IS TO ALLOW FOR ERRORS IN ALOG.
   20 RLB = 1.01E0*ALOG(FLOAT(B))
      IF (MPCMPR (X, -FLOAT(M+1)*RLB) .GE. 0) GO TO 40
C UNDERFLOW SO CALL MPUNFL AND RETURN
   30 CALL MPUNFL (Y)
      RETURN
   40 IF (MPCMPR (X, FLOAT(M)*RLB) .LE. 0) GO TO 70
C OVERFLOW HERE
   50 WRITE (LUN, 60)
   60 FORMAT (37H *** OVERFLOW IN SUBROUTINE MPEXP ***)
      CALL MPOVFL (Y)
      RETURN
C NOW SAFE TO CONVERT X TO REAL
   70 CALL MPCMR (X, RX)
C SAVE SIGN AND WORK WITH ABS(X)
      XS = X(1)
      CALL MPABS (X, R(I3))
C IF ABS(X) .GT. M POSSIBLE THAT INT(X) OVERFLOWS,
C SO DIVIDE BY 32.
      IF (ABS(RX).GT.FLOAT(M)) CALL MPDIVI (R(I3), 32, R(I3))
C GET FRACTIONAL AND INTEGER PARTS OF ABS(X)
      CALL MPCMI (R(I3), IX)
      CALL MPCMF (R(I3), R(I3))
C ATTACH SIGN TO FRACTIONAL PART AND COMPUTE EXP OF IT
      R(I3) = XS*R(I3)
      CALL MPEXP1 (R(I3), Y)
      CALL MPADDI (Y, 1, Y)
C COMPUTE E-2 OR 1/E USING TWO EXTRA DIGITS IN CASE ABS(X) LARGE
C (BUT ONLY ONE EXTRA DIGIT IF T .LT. 4)
      TSS = T
      TS = T + 2
      IF (T.LT.4) TS = T + 1
      T = TS
      I2 = T + 5
      I3 = I2 + T + 2
      R(I3) = 0
      CALL MPCIM (XS, R(I2))
      I = 1
C LOOP FOR E COMPUTATION. DECREASE T IF POSSIBLE.
   80 T = MIN0 (TS, TS + 2 + R(I2+1))
      IF (T.LE.2) GO TO 90
      I = I + 1
      CALL MPDIVI (R(I2), I*XS, R(I2))
      T = TS
      CALL MPADD2 (R(I3), R(I2), R(I3), R(I2), 0)
      IF (R(I2).NE.0) GO TO 80
C RAISE E OR 1/E TO POWER IX
   90 T = TS
      IF (XS.GT.0) CALL MPADDI (R(I3), 2, R(I3))
      CALL MPPWR (R(I3), IX, R(I3))
C RESTORE T NOW
      T = TSS
C MULTIPLY EXPS OF INTEGER AND FRACTIONAL PARTS
      CALL MPMUL (Y, R(I3), Y)
C MUST CORRECT RESULT IF DIVIDED BY 32 ABOVE.
      IF ((ABS(RX).LE.FLOAT(M)).OR.(Y(1).EQ.0)) GO TO 110
      DO 100 I = 1, 5
C SAVE EXPONENT TO AVOID OVERFLOW IN MPMUL
      IE = Y(2)
      Y(2) = 0
      CALL MPMUL (Y, Y, Y)
      Y(2) = Y(2) + 2*IE
C CHECK FOR UNDERFLOW AND OVERFLOW
      IF (Y(2).LT.(-M)) GO TO 30
      IF (Y(2).GT.M) GO TO 50
  100 CONTINUE
C CHECK THAT RELATIVE ERROR LESS THAN 0.01 UNLESS ABS(X) LARGE
C (WHEN EXP MIGHT OVERFLOW OR UNDERFLOW)
  110 IF (ABS(RX) .GT. 10.0) RETURN
      CALL MPCMR (Y, RY)
      IF (ABS(RY - EXP(RX)) .LT. (0.01*RY)) RETURN
      WRITE (LUN, 120)
C THE FOLLOWING MESSAGE MAY INDICATE THAT
C B**(T-1) IS TOO SMALL, OR THAT M IS TOO SMALL SO THE
C RESULT UNDERFLOWED.
  120 FORMAT (50H *** ERROR OCCURRED IN MPEXP, RESULT INCORRECT ***)
      CALL MPERR
      RETURN
      END
      FUNCTION MPEXPA (X)                                               MP027273
C RETURNS THE EXPONENT OF THE MP NUMBER X
C (OR LARGEST NEGATIVE EXPONENT IF X IS ZERO).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2)
      MPEXPA = -M
C RETURN -M IF X ZERO, X(2) OTHERWISE
      IF (X(1).NE.0) MPEXPA = X(2)
      RETURN
      END
      SUBROUTINE MPEXPB (I, X)                                          MP027313
C SETS EXPONENT OF MP NUMBER X TO I UNLESS X IS ZERO
C (WHEN EXPONENT IS UNCHANGED).
C X MUST BE A VALID MP NUMBER (EITHER ZERO OR NORMALIZED).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3)
C RETURN IF X IS ZERO
      IF (X(1).EQ.0) RETURN
C CHECK FOR VALID MP SIGN AND LEADING DIGIT
      IF ((IABS(X(1)).LE.1).AND.(X(3).GT.0).AND.(X(3).LT.B))
     $     GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (48H *** X NOT VALID MP NUMBER IN CALL TO MPEXPB ***)
      CALL MPERR
      X(1) = 0
      RETURN
C SET EXPONENT OF X TO I
   20 X(2) = I
C CHECK FOR OVERFLOW AND UNDERFLOW
      IF (I.GT.M) CALL MPOVFL (X)
      IF (I.LT.(-M)) CALL MPUNFL (X)
      RETURN
      END
      SUBROUTINE MPEXP1 (X, Y)                                          MP027380
C ASSUMES THAT X AND Y ARE MP NUMBERS,  -1 .LT. X .LT. 1.
C RETURNS Y = EXP(X) - 1 USING AN O(SQRT(T).M(T)) ALGORITHM
C DESCRIBED IN - R. P. BRENT, THE COMPLEXITY OF MULTIPLE-
C PRECISION ARITHMETIC (IN COMPLEXITY OF COMPUTATIONAL PROBLEM
C SOLVING, UNIV. OF QUEENSLAND PRESS, BRISBANE, 1976, 126-165).
C ASYMPTOTICALLY FASTER METHODS EXIST, BUT ARE NOT USEFUL
C UNLESS T IS VERY LARGE. SEE COMMENTS TO MPATAN AND MPPIGL.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 3T+8
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2), Q, TS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, 8)
      I2 = T + 5
      I3 = I2 + T + 2
C CHECK FOR X = 0
      IF (X(1).NE.0) GO TO 20
   10 Y(1) = 0
      RETURN
C CHECK THAT ABS(X) .LT. 1
   20 IF (X(2).LE.0) GO TO 40
      WRITE (LUN, 30)
   30 FORMAT (49H *** ABS(X) NOT LESS THAN 1 IN CALL TO MPEXP1 ***)
      CALL MPERR
      GO TO 10
   40 CALL MPSTR (X, R(I2))
      RLB = ALOG(FLOAT(B))
C COMPUTE APPROXIMATELY OPTIMAL Q (AND DIVIDE X BY 2**Q)
      Q = INT(SQRT(0.48E0*FLOAT(T)*RLB) + 1.44E0*FLOAT(X(2))*RLB)
C HALVE Q TIMES
      IF (Q.LE.0) GO TO 60
      IB = 4*B
      IC = 1
      DO 50 I = 1, Q
      IC = 2*IC
      IF ((IC.LT.IB).AND.(IC.NE.B).AND.(I.LT.Q)) GO TO 50
      CALL MPDIVI (R(I2), IC, R(I2))
      IC = 1
   50 CONTINUE
   60 IF (R(I2).EQ.0) GO TO 10
      CALL MPSTR (R(I2), Y)
      CALL MPSTR (R(I2), R(I3))
      I = 1
      TS = T
C SUM SERIES, REDUCING T WHERE POSSIBLE
   70 T = TS + 2 + R(I3+1) - Y(2)
      IF (T.LE.2) GO TO 80
      T = MIN0 (T, TS)
      CALL MPMUL (R(I2), R(I3), R(I3))
      I = I + 1
      CALL MPDIVI (R(I3), I, R(I3))
      T = TS
      CALL MPADD2 (R(I3), Y, Y, Y, 0)
      IF (R(I3).NE.0) GO TO 70
   80 T = TS
      IF (Q.LE.0) RETURN
C APPLY (X+1)**2 - 1 = X(2 + X) FOR Q ITERATIONS
      DO 90 I = 1, Q
      CALL MPADDI (Y, 2, R(I2))
   90 CALL MPMUL (R(I2), Y, Y)
      RETURN
      END
      SUBROUTINE MPEXT (I, J, X)                                        MP028010
C ROUTINE CALLED BY MPDIV AND MPSQRT TO ENSURE THAT
C RESULTS ARE REPRESENTED EXACTLY IN T-2 DIGITS IF THEY
C CAN BE.  X IS AN MP NUMBER, I AND J ARE INTEGERS.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Q, S
      IF ((X(1).EQ.0).OR.(T.LE.2).OR.(I.EQ.0)) RETURN
C COMPUTE MAXIMUM POSSIBLE ERROR IN THE LAST PLACE
      Q = (J+1)/I + 1
      S = B*X(T+1) + X(T+2)
      IF (S.GT.Q) GO TO 10
C SET LAST TWO DIGITS TO ZERO
      X(T+1) = 0
      X(T+2) = 0
      RETURN
   10 IF ((S+Q).LT.(B*B)) RETURN
C ROUND UP HERE
      X(T+1) = B - 1
      X(T+2) = B
C NORMALIZE X (LAST DIGIT B IS OK IN MPMULI)
      CALL MPMULI (X, 1, X)
      RETURN
      END
      SUBROUTINE MPGAM (X, Y)                                           MP028250
C COMPUTES MP Y = GAMMA(X) FOR MP ARGUMENT X, USING
C MPGAMQ IF ABS(X) .LE. 100 AND 240*X IS AN INTEGER,
C OTHERWISE USING MPLNGM.  SPACE REQUIRED IS THE SAME
C AS FOR MPLNGM (THOUGH ONLY 9T+20 IF MPGAMQ IS USED).
C TIME IS O(T**3).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (9, 20)
      I2 = 7*T + 17
      I3 = I2 + T + 2
      CALL MPABS (X, R(I3))
      IF (MPCMPI (R(I3), 100) .GT. 0) GO TO 20
C HERE ABS(X) .LE. 100, SEE IF 240*X IS ALMOST AN INTEGER
      CALL MPMULI (X, 240, R(I3))
      CALL MPCMI (R(I3), IX)
C COMPARE WITH IX AND IX+1 BECAUSE R(I3) COULD BE JUST
C BELOW AN INTEGER.
      DO 10 KT = 1, 2
      CALL MPADDI (R(I3), -IX, R(I2))
      IF ((R(I2).EQ.0).OR.
     $    (((R(I3+1)-R(I2+1)).GE.(T-1)).AND.
     $     (R(I3+2).GE.R(I2+2)))) GO TO 30
   10 IX = IX + 1
C HERE X IS LARGE OR NOT SIMPLE RATIONAL,
C CHECK IF ABS(X) VERY SMALL.
      IF (X(2).LE.(-T)) GO TO 110
C NOW CHECK SIGN OF X
   20 IF (X(1).LT.0) GO TO 40
C X IS POSITIVE SO USE MPLNGM DIRECTLY
      CALL MPLNGM (X, Y)
C SEE IF MPEXP WILL GIVE OVERFLOW
      IF (MPCMPR (Y, FLOAT(M)*ALOG(FLOAT(B))) .GE. 0) GO TO 80
C SAFE TO CALL MPEXP HERE EXCEPT IN VERY UNLIKELY CIRCUMSTANCES
      CALL MPEXP (Y, Y)
      RETURN
C X = IX/240 SO USE MPGAMQ UNLESS X ZERO OR NEGATIVE INTEGER.
   30 IF ((IX.LE.0).AND.(MOD(IABS(IX), 240) .EQ. 0)) GO TO 50
      CALL MPGAMQ (IX, 240, Y)
      RETURN
C HERE X IS NEGATIVE, SO USE REFLECTION FORMULA
   40 CALL MPABS  (X, Y)
C SUBTRACT EVEN INTEGER TO AVOID ERRORS NEAR POLES
      CALL MPDIVI (Y, 2, R(I3))
      CALL MPCMF (R(I3), R(I3))
      CALL MPMULI (R(I3), 2, R(I3))
      CALL MPADDQ (R(I3), 1, 2, R(I2))
      CALL MPCMI (R(I2), N)
C CHECK FOR INTEGER OVERFLOW IN MPCMI
      IF ((R(I3).NE.0).AND.(R(I3+1).GT.0).AND.(N.EQ.0)) GO TO 80
      CALL MPADDI (R(I3), -N, R(I3))
C NOW ABS(R(I3)) .LE. 1/2 AND SIGN DETERMINED BY N
      IF (R(I3).NE.0) GO TO 70
   50 WRITE (LUN, 60)
   60 FORMAT (52H *** X ZERO OR NEGATIVE INTEGER IN CALL TO MPGAM ***)
C TREAT AS OVERFLOW
      GO TO 100
   70 CALL MPPI (R(I2))
      CALL MPMUL (R(I3), R(I2), R(I3))
      CALL MPSIN (R(I3), R(I3))
      CALL MPMUL (R(I3), Y, R(I3))
      IF (R(I3).EQ.0) GO TO 80
      CALL MPDIV (R(I2), R(I3), R(I3))
      R(I3) = -((-1)**N)*R(I3)
C NOTE THAT MPLNGM PRESERVES R(I3), ... , R(I3+T+1)
      CALL MPLNGM (Y, Y)
      Y(1) = -Y(1)
      CALL MPEXP (Y, Y)
      CALL MPMUL (Y, R(I3), Y)
      RETURN
C HERE X WAS TOO LARGE OR TOO CLOSE TO A POLE
   80 WRITE (LUN, 90)
   90 FORMAT (26H *** OVERFLOW IN MPGAM ***)
  100 CALL MPOVFL (Y)
      RETURN
C HERE ABS(X) IS VERY SMALL
  110 CALL MPREC (X, Y)
      RETURN
      END
      SUBROUTINE MPGAMQ (I, J, X)                                       MP029053
C RETURNS X = GAMMA (I/J) WHERE X IS MULTIPLE-PRECISION AND
C I, J ARE SMALL INTEGERS.   THE METHOD USED IS REDUCTION OF
C THE ARGUMENT TO (0, 1) AND THEN A DIRECT
C EXPANSION OF THE DEFINING INTEGRAL TRUNCATED AT A
C SUFFICIENTLY HIGH LIMIT, USING 2T DIGITS TO
C COMPENSATE FOR CANCELLATION.
C TIME IS O(T**2) IF I/J IS NOT TOO LARGE.
C IF I/J .GT. 100 (APPROXIMATELY) IT IS FASTER TO USE
C MPGAM (IF ENOUGH SPACE IS AVAILABLE).
C MPGAMQ IS VERY SLOW IF I/J IS VERY LARGE, BECAUSE
C THE RELATION GAMMA(X+1) = X*GAMMA(X) IS USED REPEATEDLY.
C MPGAMQ COULD BE SPEEDED UP BY USING THE ASYMPTOTIC SERIES OR
C CONTINUED FRACTION FOR (INTEGRAL FROM N TO INFINITY OF
C U**(I/J-1)*EXP(-U)DU).
C IF I OR J IS TOO LARGE, INTEGER OVERFLOW WILL OCCUR, AND
C THE RESULT WILL BE INCORRECT.  THIS WILL USUALLY (BUT NOT
C ALWAYS) BE DETECTED AND AN ERROR MESSAGE GIVEN.
C DIMENSION OF R IN CALLING PROGRAM AT LEAST 6T+12.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), TS, TS2, TS3
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (6, 12)
      IS = I
      JS = J
C LOOK AT SIGN OF J
      IF (JS) 30, 10, 40
   10 WRITE (LUN, 20)
   20 FORMAT (32H *** J = 0 IN CALL TO MPGAMQ ***)
      GO TO 80
C J NEGATIVE HERE SO REVERSE SIGNS OF IS AND JS
   30 IS = -IS
      JS = -JS
C NOW JS IS POSITIVE.  REDUCE TO LOWEST TERMS.
   40 CALL MPGCD (IS, JS)
      IBT = MAX0(7*B*B, 32767)
      IJ = IBT/JS
C SEE IF JS = 1, 2, OR .GT. 2
      IF (JS - 2) 60, 50, 110
C JS = 2 HERE, FOR SPEED TREAT AS SPECIAL CASE
   50 CALL MPPI (X)
      CALL MPSQRT (X, X)
      GO TO 100
C JS = 1 HERE, CHECK THAT IS IS POSITIVE
   60 IF (IS.GT.0) GO TO 90
      WRITE (LUN, 70)
   70 FORMAT (43H *** I/J = ZERO OR NEGATIVE INTEGER IN CALL,
     $        14H TO MPGAMQ ***)
C TREAT AS OVERFLOW
   80 CALL MPOVFL (X)
      RETURN
C I/J = POSITIVE INTEGER HERE
   90 CALL MPCIM (1, X)
  100 IS2 = 1
      GO TO 150
C JS .GT. 2 HERE SO REDUCE TO (0, 1)
  110 IS2 = IS - (IS/JS)*JS
      IF (IS2.LT.0) IS2 = IS2 + JS
C NOW 0 .LT. IS2 .LT. JS.   COMPUTE UPPER LIMIT OF INTEGRAL
      N = INT(FLOAT(T)*ALOG(FLOAT(B)))
      IBTN = IBT/N
      I3 = 4*T + 11
      TS = T
      TS3 = T + 2
C INCREASE T TO COMPENSATE FOR CANCELLATION
      T = 2*T
      TS2 = T
      I2 = I3 - (T + 2)
      CALL MPCIM (N, R(I2))
      CALL MPSTR (R(I2), R(I3))
      IL = 0
      IN = JS - IS2
      ID = IS2
C MAIN LOOP
  120 IL = IL + 1
C IF TERMS DECREASING MAY DECREASE T
      IF (IL.GE.N) T = R(I3+1) + TS3
      T = MAX0 (2, MIN0 (T, TS2))
      IN = IN - JS
      ID = ID + JS
C CHECK FOR OVERFLOW HERE (ID SHOULD BE POSITIVE)
      IF (ID.LE.0) GO TO 200
C SPLIT UP CALL TO MPMULQ IF IN OR ID TOO LARGE
      IF ((IABS(IN).GT.IBTN).OR.(ID.GT.(IBT/IL))) GO TO 130
      CALL MPMULQ (R(I3), N*IN, IL*ID, R(I3))
      GO TO 140
  130 CALL MPMULQ (R(I3), N, IL, R(I3))
      CALL MPMULQ (R(I3), IN, ID, R(I3))
  140 T = MAX0 (T, TS3)
      CALL MPADD2 (R(I2), R(I3), R(I2), R(I3), 0)
C LOOP UNTIL EXPONENT SMALL
      IF ((R(I3).NE.0).AND.(R(I3+1).GE.(-TS))) GO TO 120
C RESTORE T
      T = TS
      CALL MPMULQ (R(I2), JS, IS2, X)
      CALL MPQPWR (N, 1, IS2-JS, JS, R(I3))
      CALL MPMUL (X, R(I3), X)
C NOW X IS GAMMA (IS2/JS), SO USE THE RECURRENCE RELATION
C REPEATEDLY TO GET GAMMA (I/J)  (SLOW IF I/J IS LARGE).
  150 IN = 1
      ID = 1
      IF (IS - IS2) 190, 160, 170
  160 RETURN
  170 IN = IN*IS2
      ID = ID*JS
      IS2 = IS2 + JS
      IF ((ID.LE.IJ).AND.(IABS(IN).LE.(IBT/IABS(IS2)))
     $   .AND.(IS.NE.IS2)) GO TO 170
  180 CALL MPMULQ (X, IN, ID, X)
      GO TO 150
  190 IN = IN*JS
      ID = ID*IS
      IS = IS + JS
      IF ((IN.LE.IJ).AND.(IABS(ID).LE.(IBT/IABS(IS)))
     $   .AND.(IS.NE.IS2)) GO TO 190
      GO TO 180
C HERE INTEGER OVERFLOW OCCURRED, J MUST HAVE BEEN TOO LARGE
  200 WRITE (LUN, 210)
  210 FORMAT (31H *** INTEGER OVERFLOW OCCURRED,,
     $  34H J TOO LARGE IN CALL TO MPGAMQ ***)
      CALL MPERR
      X(1) = 0
      RETURN
      END
      SUBROUTINE MPGCD (K, L)                                           MP029313
C RETURNS K = K/GCD AND L = L/GCD, WHERE GCD IS THE
C GREATEST COMMON DIVISOR OF K AND L.
C SAVE INPUT PARAMETERS IN LOCAL VARIABLES
      I = K
      J = L
      IS = IABS(I)
      JS = IABS(J)
      IF (JS.EQ.0) GO TO 30
C EUCLIDEAN ALGORITHM LOOP
   10 IS = MOD (IS, JS)
      IF (IS.EQ.0) GO TO 20
      JS = MOD (JS, IS)
      IF (JS.NE.0) GO TO 10
      JS = IS
C HERE JS IS THE GCD OF I AND J
   20 K = I/JS
      L = J/JS
      RETURN
C IF J = 0 RETURN (1, 0) UNLESS I = 0, THEN (0, 0)
   30 K = 1
      IF (IS.EQ.0) K = 0
      L = 0
      RETURN
      END
      SUBROUTINE MPGCDA (X, Y, Z)                                       MP029372
C RETURNS Z = GREATEST COMMON DIVISOR OF X AND Y.
C GCD (X, 0) = GCD (0, X) = ABS(X), GCD (X, Y) .GE. 0.
C X, Y AND Z ARE INTEGERS REPRESENTED AS MP NUMBERS,
C AND MUST SATISFY ABS(X) .LT. B**T, ABS(Y) .LT. B**T
C TIME O(T**2), SPACE = 4T+10.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), Z(1), TS
      CALL MPCHK (3, 8)
      TS = T
      I2 = T + 5
      I3 = I2 + T + 2
      I4 = I3 + T + 2
      CALL MPCMIM (X, R(I2))
C CHECK THAT X EXACT INTEGER
      IF (MPCOMP (X, R(I2)) .NE. 0) GO TO 40
      R(I2) = IABS (R(I2))
      CALL MPCMIM (Y, R(I3))
C CHECK THAT Y EXACT INTEGER
      IF (MPCOMP (Y, R(I3)) .NE. 0) GO TO 40
      R(I3) = IABS (R(I3))
C CHECK FOR X OR Y ZERO
      IF (X(1).NE.0) GO TO 20
   10 T = TS
      CALL MPSTR (R(I3), Z)
      RETURN
   20 IF (Y(1).NE.0) GO TO 30
      CALL MPSTR (R(I2), Z)
      RETURN
C CHECK THAT ABS(X), ABS(Y) .LT. B**T
   30 IF ((R(I2+1).LE.T).AND.(R(I3+1).LE.T)) GO TO 60
   40 WRITE (LUN, 50)
   50 FORMAT (36H *** X OR Y NON-INTEGER OR TOO LARGE,
     $        22H IN CALL TO MPGCDA ***)
      CALL MPERR
      Z(1) = 0
      RETURN
C START OF MAIN EUCLIDEAN ALGORITHM LOOP
   60 IF (R(I2).EQ.0) GO TO 10
      IF (MPCOMP (R(I2), R(I3))) 70, 10, 80
C EXCHANGE POINTERS ONLY
   70 IS = I2
      I2 = I3
      I3 = IS
C CHECK FOR SMALL EXPONENT
   80 IF (R(I2+1).LE.2) GO TO 110
C REDUCE T (TRAILING DIGITS MUST BE ZERO)
      T = R(I2+1)
      CALL MPSTR (R(I3), R(I4))
C FORCE EXPONENTS TO BE EQUAL
      R(I4+1) = R(I2+1)
C GET FIRST TWO DIGITS
      IQ = B*R(I2+2) + R(I2+3)
      IF (MPCOMP (R(I2), R(I4)) .GE. 0) GO TO 90
C REDUCE EXPONENT BY ONE
      R(I4+1) = R(I4+1) - 1
C UNDERESTIMATE QUOTIENT
      IQ = IQ/(R(I4+2)+1)
      GO TO 100
C LEHMERS METHOD WOULD SAVE SOME MP OPERATIONS BUT NOT VERY
C MANY UNLESS WE COULD USE DOUBLE-PRECISION SAFELY.
   90 IQ = MAX0 (1, IQ/(B*R(I4+2) + R(I4+3) + 1))
  100 CALL MPMULI (R(I4), IQ, R(I4))
      CALL MPSUB (R(I2), R(I4), R(I2))
      GO TO 60
C HERE SAFE TO USE INTEGER ARITHMETIC
  110 CALL MPCMI (R(I2), I)
      CALL MPCMI (R(I3), J)
      T = TS
  120 I = MOD (I, J)
      IF (I.EQ.0) GO TO 130
      J = MOD (J, I)
      IF (J.NE.0) GO TO 120
      J = I
  130 CALL MPCIM (J, Z)
      RETURN
      END
      SUBROUTINE MPGCDB (X, Y)                                          MP029532
C RETURNS (X, Y) AS (X/Z, Y/Z) WHERE Z IS THE GCD OF X AND Y.
C X AND Y ARE INTEGERS REPRESENTED AS MP NUMBERS,
C AND MUST SATISFY ABS(X) .LT. B**T, ABS(Y) .LT. B**T
C TIME O(T**2), SPACE = 5T+12.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
      CALL MPCHK (5, 12)
      I2 = 4*T + 11
C FIND GCD OF X AND Y USING MPGCDA
      CALL MPGCDA (X, Y, R(I2))
C CHECK FOR X AND Y EQUAL (WHEN MAY COINCIDE)
      IF (MPCOMP (X, Y) .NE. 0) GO TO 10
      IS = X(1)
      CALL MPCIM (IS, X)
      CALL MPSTR (X, Y)
      RETURN
C CHECK IF GCD IS SMALL.
   10 IF (MPCMPI (R(I2), 7*MAX0 (B*B, 4096)) .GT. 0) GO TO 20
      CALL MPCMI (R(I2), IZ)
      IF (IZ.EQ.1) RETURN
      CALL MPDIVI (X, IZ, X)
      CALL MPDIVI (Y, IZ, Y)
      RETURN
C HERE GCD IS LARGE
   20 CALL MPREC (R(I2), R(I2))
      CALL MPMUL (X, R(I2), X)
      CALL MPMUL (Y, R(I2), Y)
C ADD SIGN/2 AND TRUNCATE TO GET CORRECT INTEGER
      IS = X(1)
      CALL MPADDQ (X, IS, 2, X)
      CALL MPCMIM (X, X)
      IS = Y(1)
      CALL MPADDQ (Y, IS, 2, Y)
      CALL MPCMIM (Y, Y)
      RETURN
      END
      LOGICAL FUNCTION MPGE (X, Y)                                      MP030523
C RETURNS LOGICAL VALUE OF (X .GE. Y) FOR MP X AND Y.
      INTEGER X(1), Y(1)
      MPGE = (MPCOMP(X,Y) .GE. 0)
      RETURN
      END
      LOGICAL FUNCTION MPGT (X, Y)                                      MP030543
C RETURNS LOGICAL VALUE OF (X .GT. Y) FOR MP X AND Y.
      INTEGER X(1), Y(1)
      MPGT = (MPCOMP(X,Y) .GT. 0)
      RETURN
      END
      SUBROUTINE MPHANK (X, NU, Y, ERROR)                               MP030570
C TRIES TO COMPUTE THE BESSEL FUNCTION J(NU,X) USING HANKELS
C ASYMPTOTIC SERIES.  NU IS A NONNEGATIVE INTEGER .LE. MAX(B,64),
C ERROR IS AN INTEGER, X AND Y ARE MP NUMBERS.
C RETURNS ERROR = 0 IF SUCCESSFUL (RESULT IN Y),
C         ERROR = 1 IF UNSUCCESSFUL (Y UNCHANGED)
C ERROR COULD BE INDUCED BY O(B**(1-T)) PERTURBATIONS IN
C X AND Y.   TIME IS O(T**3).
C CALLED BY MPBESJ, SPACE = 11T+24
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(1), Y(1), ERROR
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (11, 24)
      ERROR = 1
      B2 = MAX0(B, 64)
C GIVE ERROR RETURN IF NU IS NEGATIVE OR TOO LARGE.
      IF ((NU.LT.0).OR.(NU.GT.B2)) RETURN
      I2 = 5*T + 13
      I3 = I2 + T + 2
      I4 = I3 + T + 2
      I5 = I4 + T + 2
      I6 = I5 + T + 2
      I7 = I6 + T + 2
C WORK WITH ABS(X)
      CALL MPABS (X, R(I2))
C CHECK IF ABS(X) CLEARLY TOO SMALL FOR ASYMPTOTIC SERIES
      IF (MPCMPR (R(I2), 0.5E0*FLOAT(T)*ALOG(FLOAT(B))).LE.0) RETURN
      CALL MPPWR (X, -2, R(I3))
      CALL MPDIVI (R(I3), -64, R(I3))
      CALL MPCIM (1, R(I4))
      R(I5) = 0
      CALL MPSTR (R(I4), R(I6))
      IE = 1
      K = 0
C LOOP TO SUM TWO ASYMPTOTIC SERIES
   10 K = K + 2
C ERROR RETURN IF TERMS INCREASING
      IF (R(I6+1).GT.IE) RETURN
      IE = R(I6+1)
      IF (K.GT.B2) GO TO 20
      CALL MPMULQ (R(I6), (2*(NU+K)-3)*(2*(NU-K)+3), K-1, R(I6))
      CALL MPADD (R(I5), R(I6), R(I5))
      CALL MPMULQ (R(I6), (2*(NU+K)-1)*(2*(NU-K)+1), K, R(I6))
      GO TO 30
C HERE NEED TO SPLIT UP CALLS TO MPMULQ
   20 CALL MPMULQ (R(I6), 2*(NU+K)-3, K-1, R(I6))
      CALL MPMULI (R(I6), 2*(NU-K)+3, R(I6))
      CALL MPADD (R(I5), R(I6), R(I5))
      CALL MPMULQ (R(I6), 2*(NU+K)-1, K, R(I6))
      CALL MPMULI (R(I6), 2*(NU-K)+1, R(I6))
   30 CALL MPMUL (R(I6), R(I3), R(I6))
      CALL MPADD (R(I4), R(I6), R(I4))
C LOOP IF TERMS NOT SUFFICIENTLY SMALL YET
      IF ((R(I6).NE.0).AND.(R(I6+1).GT.(-T))) GO TO 10
C END OF ASYMPTOTIC SERIES, NOW COMPUTE RESULT
      CALL MPDIV (R(I5), R(I2), R(I5))
      CALL MPDIVI (R(I5), 8, R(I5))
C COMPUTE PI/4 (SLIGHTLY MORE ACCURATE THAN CALLING
C MPPI AND DIVIDING BY FOUR)
      CALL MPART1 (5, R(I6))
      CALL MPMULI (R(I6), 4, R(I6))
      CALL MPART1 (239, R(I3))
      CALL MPSUB (R(I6), R(I3), R(I3))
C AVOID TOO MUCH CANCELLATION IN SUBTRACTING MULTIPLE OF PI
      CALL MPMULI (R(I3), MOD (2*NU+1, 8), R(I6))
      CALL MPSUB (R(I2), R(I6), R(I6))
C COULD SAVE SOME TIME BY NOT COMPUTING BOTH SIN AND COS
      CALL MPCOS (R(I6), R(I7))
      CALL MPMUL (R(I4), R(I7), R(I4))
      CALL MPSIN (R(I6), R(I7))
      CALL MPMUL (R(I5), R(I7), R(I5))
      CALL MPSUB (R(I4), R(I5), R(I4))
      CALL MPMUL (R(I3), R(I2), R(I3))
      CALL MPMULI (R(I3), 2, R(I3))
      CALL MPROOT (R(I3), -2, R(I3))
      CALL MPMUL (R(I3), R(I4), R(I3))
C CORRECT SIGN OF RESULT
      IF (MOD (NU, 2) .NE. 0) R(I3) = R(I3)*X(1)
      ERROR = 0
      CALL MPSTR (R(I3), Y)
      RETURN
      END
      SUBROUTINE MPIN (C, X, N, ERROR)                                  MP031400
C CONVERTS THE FIXED-POINT DECIMAL NUMBER (READ UNDER NA1
C FORMAT) IN C(1) ... C(N) TO A MULTIPLE-PRECISION NUMBER
C IN X.   IF C REPRESENTS A VALID NUMBER, ERROR IS RETURNED
C AS 0.  IF C DOES NOT REPRESENT A VALID NUMBER, ERROR
C IS RETURNED AS 1 AND X AS ZERO.
C LEADING AND TRAILING BLANKS ARE ALLOWED, EMBEDDED BLANKS
C (EXCEPT BETWEEN THE NUMBER AND ITS SIGN) ARE FORBIDDEN.
C IF THERE IS NO DECIMAL POINT ONE IS ASSUMED TO LIE JUST TO
C THE RIGHT OF THE LAST DECIMAL DIGIT.
C FOR EFFICIENCY CHOOSE B A POWER OF 10.
C X IS AN MP NUMBER, C AN INTEGER ARRAY, N AND ERROR INTEGERS.
C DIMENSION OF R IN CALLING PROGRAM .GE. 3T+11.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), C(1), X(1), NUM(14), ERROR
      INTEGER FIRST, S, TEN, TP
      DATA NUM(1), NUM(2), NUM(3) / 1H0, 1H1, 1H2 /
      DATA NUM(4), NUM(5), NUM(6) / 1H3, 1H4, 1H5 /
      DATA NUM(7), NUM(8), NUM(9) / 1H6, 1H7, 1H8 /
      DATA NUM(10), NUM(11), NUM(12) / 1H9, 1H , 1H. /
      DATA NUM(13), NUM(14) / 1H+, 1H- /
C TO READ INPUT IN OCTAL CHANGE 10 TO 8 IN NEXT
C DATA STATEMENT.  SIMILARLY FOR OTHER BASES LESS THAN 10.
      DATA TEN /10/
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (3, 11)
C CHECK FOR N .GT. 0
      IF (N.GT.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (39H *** N NOT POSITIVE IN CALL TO MPIN ***)
      CALL MPERR
      X(1) = 0
      RETURN
   20 I2 = 2*T + 9
C USE ONE GUARD DIGIT
      CALL MPCLR (R(I2), T+1)
      T = T + 1
      FIRST = 1
      R(I2) = 0
      S = 1
      ERROR = 0
      IP = 0
      K = 0
C SCAN C FROM LEFT, SKIPPING BLANKS
   30 K = K + 1
      IF (C(K).NE.NUM(11)) GO TO 60
   40 IF (K.LT.N) GO TO 30
C FIELD WAS ALL BLANK - TREAT AS ERROR CONDITION
   50 X(1) = 0
      ERROR = 1
      T = T - 1
      RETURN
C NONBLANK CHARACTER FOUND
   60 DO 70 I = 1, 14
      J = I
      IF (C(K).EQ.NUM(I)) GO TO 80
   70 CONTINUE
C ILLEGAL CHARACTER, SO ERROR
      GO TO 50
C LEGAL CHARACTER, SEE IF DIGIT OR POINT
   80 IF (J.GT.10) GO TO 100
C MUST BE DIGIT, SO CONTINUE FORMING NUMBER
      CALL MPMULI (R(I2), TEN, R(I2))
      CALL MPADDI (R(I2), J-1, R(I2))
      FIRST = 0
      K = K + 1
      IF (K.LE.N) GO TO 60
C RESTORE T, ROUND RESULT AND RETURN
   90 I3 = I2 + T
      T = T - 1
      IF ((2*R(I3+1)).GT.B) R(I3) = R(I3) + 1
C MULTIPLICATION BY +-1 ALSO FIXES UP LAST DIGIT IF NECESSARY
      CALL MPMULI (R(I2), S, X)
      RETURN
C NONDIGIT FOUND, IS IT SIGN, BLANK, OR POINT
  100 IF (J.EQ.12) GO TO 110
      IF (J.EQ.11) GO TO 170
C MUST BE SIGN, ONLY LEGAL IF FIRST = 1
      IF (FIRST.EQ.0) GO TO 50
      IF (J.EQ.14) S = -1
      FIRST = 0
      GO TO 40
C POINT ENCOUNTERED
  110 IP = 0
  120 K = K + 1
      IF (K.GT.N) GO TO 150
C LOOK AT C(K)
      DO 130 I = 1, 11
      J = I
      IF (C(K).EQ.NUM(I)) GO TO 140
  130 CONTINUE
C ILLEGAL CHARACTER
      GO TO 50
C IF BLANK GO TO 170
  140 IF (J.EQ.11) GO TO 170
C DIGIT (AFTER POINT)
      IP = IP + 1
      CALL MPMULI (R(I2), TEN, R(I2))
      CALL MPADDI (R(I2), J-1, R(I2))
      GO TO 120
C END OF INPUT FIELD, MULTIPLY BY TEN**(-IP)
  150 IF (IP.LE.0) GO TO 90
      IB = MAX0(7*B*B, 32767)/TEN
      TP = 1
      DO 160 I = 1, IP
      TP = TEN*TP
      IF ((TP.LE.IB).AND.(TP.NE.B).AND.(I.LT.IP)) GO TO 160
      CALL MPDIVI (R(I2), TP, R(I2))
      TP = 1
  160 CONTINUE
      GO TO 90
C TRAILING BLANK, CHECK THAT ALL TO RIGHT ARE BLANKS
  170 DO 180 I = K, N
      IF (C(I).NE.NUM(11)) GO TO 50
  180 CONTINUE
      GO TO 150
      END
      SUBROUTINE MPINE (C, X, N, J, ERROR)                              MP032573
C SAME AS MPIN EXCEPT THAT THE RESULT (X) IS MULTIPLIED BY
C 10**J, WHERE J IS A SINGLE-PRECISION INTEGER.  FOR DETAILS
C OF THE OTHER ARGUMENTS, SEE MPIN.
C USEFUL FOR FLOATING-POINT INPUT OF MP NUMBERS.  THE USER CAN
C READ THE EXPONENT INTO J (USING ANY SUITABLE FORMAT) AND
C THE FRACTION INTO C (USING A1 FORMAT), THEN CALL MPINE TO
C CONVERT TO MULTIPLE-PRECISION.
C SPACE = 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), C(1), X(1), ERROR, TEN
C CHANGE NEXT DATA STATEMENT IF INPUT RADIX NOT 10
      DATA TEN /10/
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (5, 12)
C CALL MPIN TO CONVERT C TO MP FORMAT
      CALL MPIN (C, X, N, ERROR)
C RETURN IF J ZERO OR X ZERO
      IF ((J.EQ.0).OR.(X(1).EQ.0)) RETURN
C OTHERWISE MULTIPLY BY TEN**J
      JA = IABS(J)
C THE NUMBERS -500 AND 100 WERE DETERMINED EMPIRICALLY.  THE OPTIMUM
C CHOICE DEPENDS ON B AND T.
      IF ((J.GT.(-500)).AND.(J.LT.100)) GO TO 10
C HERE EXPONENT LARGE, SO USE MPPWR TO COMPUTE TEN**ABS(J)
C LEAVE SPACE FOR MPDIV
      I2 = 4*T + 11
      CALL MPCIM (TEN, R(I2))
      CALL MPPWR (R(I2), JA, R(I2))
      IF (J.LT.0) CALL MPDIV (X, R(I2), X)
      IF (J.GE.0) CALL MPMUL (X, R(I2), X)
      RETURN
C HERE ABS(J) IS SMALL SO PROBABLY FASTER TO USE MPDIVI OR MPMULI
   10 JP = 1
      IB = MAX0 (7*B*B, 32767)/TEN
      DO 20 I = 1, JA
      JP = TEN*JP
      IF ((JP.LE.IB).AND.(JP.NE.B).AND.(I.LT.JA)) GO TO 20
      IF (J.LT.0) CALL MPDIVI (X, JP, X)
      IF (J.GE.0) CALL MPMULI (X, JP, X)
      JP = 1
   20 CONTINUE
      RETURN
      END
      SUBROUTINE MPINF (X, N, UNIT, IFORM, ERR)                         MP032763
C READS N WORDS FROM LOGICAL UNIT IABS(UNIT) USING FORMAT IN IFORM,
C THEN CONVERTS TO MP NUMBER X USING ROUTINE MPIN.
C IFORM SHOULD CONTAIN A FORMAT WHICH ALLOWS FOR READING N WORDS
C IN A1 FORMAT, E.G. 6H(80A1)
C ERR RETURNED AS TRUE IF MPIN COULD NOT INTERPRET INPUT AS
C AN MP NUMBER OR IF N NOT POSITIVE, OTHERWISE FALSE.
C IF ERR IS TRUE THEN X IS RETURNED AS ZERO.
C SPACE REQUIRED 3T+N+11.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), UNIT, IFORM(1)
      LOGICAL ERR
C CHECK THAT ENOUGH SPACE AVAILABLE
      CALL MPCHK (3, N+11)
      I2 = 3*T + 12
C READ N WORDS UNDER FORMAT IFORM.
      CALL MPIO (R(I2), N, (-IABS(UNIT)), IFORM, ERR)
      X(1) = 0
C RETURN IF ERROR
      IF (ERR) RETURN
C ELSE CONVERT TO MP NUMBER.
      CALL MPIN (R(I2), X, N, IER)
C RETURN ERROR FLAG IF MPIN OBJECTED
      ERR = (IER.NE.0)
      RETURN
      END
      SUBROUTINE MPINIT (X)                                             MP032823
C DECLARES BLANK COMMON (USED BY MP PACKAGE) AND
C CALLS MPSET TO INITIALIZE PARAMETERS
C THE AUGMENT DECLARATION
C       INITIALIZE MP
C CAUSES A CALL TO MPINIT TO BE GENERATED.
C *** ASSUMES OUTPUT UNIT 6, 43 DECIMAL PLACES,
C *** 10 MP DIGITS, SPACE 296 WORDS.  IF THE AUGMENT
C *** DESCRIPTION DECK IS CHANGED THIS ROUTINE SHOULD
C *** BE CHANGED ACCORDINGLY.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, X(1)
C THE STATEMENTS
      INTEGER R(296)
      CALL MPSET (6, 43, 12, 296)
C ARE A SPECIAL CASE OF
C     INTEGER R(MXR)
C     CALL MPSET (LUN, IDECPL, T+2, MXR)
C WHERE LUN IS THE LOGICAL UNIT FOR OUTPUT,
C IDECPL IS THE EQUIVALENT NUMBER OF DECIMAL PLACES REQUIRED,
C T IS THE NUMBER OF MP DIGITS, AND
C MXR IS THE SIZE OF THE WORKING AREA USED BY MP
C (MXR = MAX (T*T+15*T+27, 14*T+156) IS SUFFICIENT).
C TO CHANGE THE PRECISION, MODIFY THE DIMENSIONS IN THE
C DECLARE STATEMENTS IN THE AUGMENT DESCRIPTION DECK -
C THE DIMENSION FOR TYPE MULTIPLE SHOULD BE T+2 AND
C FOR TYPE MULTIPAK SHOULD BE INT ((T+3)/2).
C SEE COMMENTS IN ROUTINE MPSET FOR THE NUMBER OF MP
C DIGITS REQUIRED TO GIVE THE EQUIVALENT OF ANY DESIRED
C NUMBER OF DECIMAL PLACES.
C *** ON SOME SYSTEMS A DECLARATION OF BLANK COMMON IN THE MAIN
C *** PROGRAM MAY BE NECESSARY.  IF SO, DECLARE
C ***       COMMON MPWORK(301)
C *** OR, MORE GENERALLY,
C ***       COMMON MPWORK(MXR+5)
C *** IN THE MAIN PROGRAM.
      RETURN
      END
      SUBROUTINE MPIO (C, N, UNIT, IFORM, ERR)                          MP032923
C IF UNIT .GT. 0 WRITES C(1), ... , C(N) IN FORMAT IFORM
C IF UNIT .LE. 0 READS  C(1), ... , C(N) IN FORMAT IFORM
C IN BOTH CASES USES LOGICAL UNIT IABS(UNIT).
C ERR IS RETURNED AS TRUE IF N NON-POSITIVE, OTHERWISE FALSE.
C WE WOULD LIKE TO RETURN ERR AS TRUE IF READ/WRITE ERROR DETECTED,
C BUT THIS CAN NOT BE DONE WITH ANSI STANDARD FORTRAN (1966).
C *** UNIVAC ASCII FORTRAN (FTN 5R1AE) DOES NOT WORK IF IFORM
C *** IS DECLARED WITH DIMENSION 1.  MOST FORTRANS DO THOUGH.
      INTEGER C(N), UNIT, IFORM(20)
      LOGICAL ERR
      ERR = (N.LE.0)
      IF (ERR) RETURN
      IU = IABS(UNIT)
      IF (UNIT.GT.0) WRITE (IU, IFORM) C
      IF (UNIT.LE.0) READ  (IU, IFORM) C
      RETURN
      END
      SUBROUTINE MPKSTR (X, Y)                                          MP032963
C SETS Y = X FOR PACKED MP NUMBERS X AND Y.
C ASSUMES SAME PACKED FORMAT AS MPPACK AND MPUNPK.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2)
      Y(2) = X(2)
C CHECK FOR ZERO
      IF (Y(2).EQ.0) RETURN
C HERE X NONZERO SO MOVE PACKED NUMBER
      N = (T+3)/2
      DO 10 I = 1, N
   10 Y(I) = X(I)
      RETURN
      END
      LOGICAL FUNCTION MPLE (X, Y)                                      MP033003
C RETURNS LOGICAL VALUE OF (X .LE. Y) FOR MP X AND Y.
      INTEGER X(1), Y(1)
      MPLE = (MPCOMP(X,Y) .LE. 0)
      RETURN
      END
      SUBROUTINE MPLI (X, Y)                                            MP033030
C RETURNS Y = LI(X) = LOGARITHMIC INTEGRAL OF X
C           = (PRINCIPAL VALUE INTEGRAL FROM 0 TO X OF
C              DU/LOG(U)),
C USING MPEI.  X AND Y ARE MP NUMBERS, X .GE. 0, X .NE. 1.
C ERROR IN Y COULD BE INDUCED BY AN O(B**(1-T)) RELATIVE
C PERTURBATION IN X FOLLOWED BY SIMILAR PERTURBATION IN Y.
C THUS RELATIVE ERROR IN Y IS SMALL UNLESS X IS CLOSE TO
C 1 OR TO THE ZERO 1.45136923488338105028... OF LI(X).
C TIME IS O(T.M(T)), SPACE = 10T+38
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (10, 38)
      IF (X(1)) 10, 30, 40
C HERE X NEGATIVE, GIVE ERROR MESSAGE
   10 WRITE (LUN, 20)
   20 FORMAT (35H *** X NEGATIVE IN CALL TO MPLI ***)
      CALL MPERR
C LI(0) = 0
   30 Y(1)= 0
      RETURN
C HERE X IS POSITIVE, SEE IF EQUAL TO 1
   40 IF (MPCMPI (X, 1) .NE. 0) GO TO 60
C HERE X EXACTLY EQUAL TO 1, GIVE ERROR MESSAGE AND
C TREAT AS MP OVERFLOW
      WRITE (LUN, 50)
   50 FORMAT (33H *** X .EQ. 1 IN CALL TO MPLI ***)
      CALL MPOVFL (Y)
      RETURN
C HERE X POSITIVE AND .NE. 1, SO USE EI(LN(X))
   60 CALL MPLN (X, Y)
      CALL MPEI (Y, Y)
      RETURN
      END
      SUBROUTINE MPLN (X, Y)                                            MP033390
C RETURNS Y = LN(X), FOR MP X AND Y, USING MPLNS.
C RESTRICTION - INTEGER PART OF LN(X) MUST BE REPRESENTABLE
C AS A SINGLE-PRECISION INTEGER.  TIME IS O(SQRT(T).M(T)).
C FOR SMALL INTEGER X, MPLNI IS FASTER.
C ASYMPTOTICALLY FASTER METHODS EXIST (EG THE GAUSS-SALAMIN
C METHOD, SEE MPLNGS), BUT ARE NOT USEFUL UNLESS T IS LARGE.
C SEE COMMENTS TO MPATAN, MPEXP1 AND MPPIGL.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 6T+14.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), E
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (6, 14)
      I2 = 4*T + 11
      I3 = I2 + T + 2
C CHECK THAT X IS POSITIVE
      IF (X(1).GT.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (38H *** X NONPOSITIVE IN CALL TO MPLN ***)
      CALL MPERR
      Y(1) = 0
      RETURN
C MOVE X TO LOCAL STORAGE
   20 CALL MPSTR (X, R(I2))
      Y(1) = 0
      K = 0
C LOOP TO GET APPROXIMATE LN(X) USING SINGLE-PRECISION
   30 CALL MPADDI (R(I2), -1, R(I3))
C IF POSSIBLE GO TO CALL MPLNS
      IF ((R(I3).EQ.0).OR.((R(I3+1)+1).LE.0)) GO TO 50
C REMOVE EXPONENT TO AVOID FLOATING-POINT OVERFLOW
      E = R(I2+1)
      R(I2+1) = 0
      CALL MPCMR (R(I2), RX)
C RESTORE EXPONENT AND COMPUTE SINGLE-PRECISION LOG
      R(I2+1) = E
      RLX = ALOG(RX) + FLOAT(E)*ALOG(FLOAT(B))
      CALL MPCRM (-RLX, R(I3))
C UPDATE Y AND COMPUTE ACCURATE EXP OF APPROXIMATE LOG
      CALL MPSUB (Y, R(I3), Y)
      CALL MPEXP (R(I3), R(I3))
C COMPUTE RESIDUAL WHOSE LOG IS STILL TO BE FOUND
      CALL MPMUL (R(I2), R(I3), R(I2))
C MAKE SURE NOT LOOPING INDEFINITELY
      K = K + 1
      IF (K.LT.10) GO TO 30
      WRITE (LUN, 40)
   40 FORMAT (48H *** ERROR IN MPLN, ITERATION NOT CONVERGING ***)
      CALL MPERR
      RETURN
C COMPUTE FINAL CORRECTION ACCURATELY USING MPLNS
   50 CALL MPLNS (R(I3), R(I3))
      CALL MPADD (Y, R(I3), Y)
      RETURN
      END
      SUBROUTINE MPLNGM (X, Y)                                          MP033950
C RETURNS MP Y = LN(GAMMA(X)) FOR POSITIVE MP X, USING STIRLINGS
C ASYMPTOTIC APPROXIMATION.  SLOWER THAN MPGAMQ (UNLESS X LARGE)
C AND USES MORE SPACE, SO USE MPGAMQ AND MPLN IF X IS RATIONAL AND
C NOT TOO LARGE, SAY X .LE. 100.  TIME IS O(T**3).
C SPACE REQUIRED IS 11T+24+NL*((T+3)/2), WHERE NL IS THE NUMBER
C OF TERMS USED IN THE ASYMPTOTIC EXPANSION,
C NL .LE. 2+AL*T*LN(B), WHERE AL IS GIVEN BELOW.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), P
C AL .LT. 1 IS CHOSEN EMPIRICALLY TO MINIMIZE TIME.
      DATA AL /0.125E0/
C CHECK LEGALITY OF B, T, M, LUN AND MXR
C ASSUMING THAT NL IS ZERO
      CALL MPCHK (11, 24)
C MAKE PRELIMINARY ESTIMATE OF NL
      AB = ALOG(FLOAT(B))
      NLP = INT(AL*FLOAT(T)*AB) + 2
C ESTIMATE HOW LARGE X NEEDS TO BE FOR SUFFICIENT ACCURACY
      XL = FLOAT(NLP)*EXP(0.5E0/AL-1E0)/3.14159E0
C CHECK THAT X IS POSITIVE
      IF (X(1).GT.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (40H *** X NONPOSITIVE IN CALL TO MPLNGM ***)
      CALL MPERR
      Y(1) = 0
      RETURN
C ALLOW SPACE FOR MPBERN AND LEAVE R(8T+19) TO R(9T+20) FOR MPGAM
   20 I2 = 7*T + 17
      I4 = 9*T + 21
      I5 = I4 + T + 2
      I6 = I5 + T + 2
C MOVE X AND SET Y = 0
      CALL MPSTR (X, R(I4))
      Y(1) = 0
C SEE IF X LARGE ENOUGH TO USE ASYMPTOTIC SERIES
      IF (MPCMPR (R(I4), XL) .GE. 0) GO TO 40
C HERE X NOT LARGE ENOUGH, SO INCREASE USING THE
C IDENTITY GAMMA(X+1) = X*GAMMA(X) TO CORRECT RESULT
      CALL MPCIM (1, Y)
   30 CALL MPMUL (Y, R(I4), Y)
      CALL MPADDI (R(I4), 1, R(I4))
      IF (MPCMPR (R(I4), XL) .LT. 0) GO TO 30
      CALL MPLN (Y, Y)
      Y(1) = -Y(1)
C COMPUTE FIRST TERMS IN STIRLINGS APPROXIMATION
   40 CALL MPLN (R(I4), R(I5))
      CALL MPADDQ (R(I4), -1, 2, R(I2))
      CALL MPMUL (R(I2), R(I5), R(I5))
      CALL MPSUB (R(I5), R(I4), R(I5))
      CALL MPADD (Y, R(I5), Y)
      CALL MPPI (R(I5))
      CALL MPMULI (R(I5), 2, R(I5))
      CALL MPLN (R(I5), R(I5))
      CALL MPDIVI (R(I5), 2, R(I5))
      CALL MPADD (Y, R(I5), Y)
C IF X VERY LARGE CAN RETURN HERE
      IF (R(I4+1).GE.T) RETURN
C DEPENDING ON HOW LARGE X IS, MAY BE ABLE TO DECREASE NL HERE
      IR2 = R(I4+1)
C CONVERT TO REAL AFTER ENSURING NO OVERFLOW
      R(I4+1) = 0
      CALL MPCMR (R(I4), RX)
      R(I4+1) = IR2
      XLN = 1.0E0 + ALOG(3.14159E0*RX/FLOAT(NLP)) + AB*FLOAT(IR2)
      NL = MIN0 (NLP, INT(0.5E0*FLOAT(T)*AB/XLN))
      IF (NL.LE.0) RETURN
      CALL MPPWR (R(I4), -2, R(I5))
      P = (T+3)/2
C CHECK THAT MXR LARGE ENOUGH
      CALL MPCHK (11, NL*P+24)
C COMPUTE BERNOULLI NUMBERS REQUIRED (MUCH TIME COULD BE
C SAVED IF THESE WERE PRECOMPUTED)
      CALL MPBERN (NL, P, R(I6))
C SUM ASYMPTOTIC SERIES
      DO 50 I = 1, NL
      IP = I6 + (I-1)*P
      CALL MPUNPK (R(IP), R(I2))
      CALL MPDIVI (R(I2), 2*I, R(I2))
      CALL MPDIVI (R(I2), 2*I-1, R(I2))
      CALL MPMUL (R(I4), R(I5), R(I4))
      CALL MPMUL (R(I4), R(I2), R(I2))
      IF ((R(I2).EQ.0).OR.(R(I2+1).LE.(-T))) RETURN
   50 CALL MPADD (Y, R(I2), Y)
      RETURN
      END
      SUBROUTINE MPLNGS (X, Y)                                          MP034820
C RETURNS Y = LN(X) FOR MP X AND Y, USING THE GAUSS-SALAMIN
C ALGORITHM BASED ON THE ARITHMETIC-GEOMETRIC MEAN ITERATION
C (SEE ANALYTIC COMPUTATIONAL COMPLEXITY (ED. BY J. F. TRAUB),
C ACADEMIC PRESS, 1976, 151-176) UNLESS X IS CLOSE TO 1.
C SPACE = 6T+26, TIME = O(LOG(T)M(T)) + O(T**2) IF
C ABS(X-1) .GE. 1/B AND AS FOR MPLNS OTHERWISE.
C SLOWER THAN MPLN UNLESS T IS LARGE (.GE. ABOUT 500) SO
C MAINLY USEFUL FOR TESTING PURPOSES.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1), E, T2
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (6, 26)
      IF (X(1).GT.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (40H *** X NONPOSITIVE IN CALL TO MPLNGS ***)
      CALL MPERR
      Y(1) = 0
      RETURN
C ALLOW SPACE FOR MPSQRT WITH T+2 DIGITS (OVERLAP R(I2))
   20 I2 = 3*T + 15
      I3 = I2 + T + 4
      I4 = I3 + T + 4
C SEE IF X CLOSE TO 1
      CALL MPADDI (X, -1, R(I4))
      IF ((R(I4).NE.0).AND.(R(I4+1).GE.0)) GO TO 30
C HERE ABS(X-1) .LT. 1/B SO GAUSS-SALAMIN ALGORITHM COULD BE
C INACCURATE BECAUSE OF CANCELLATION.  THE PRECISION COULD BE
C INCREASED TO COMPENSATE FOR THIS, BUT SIMPLER TO USE MPLNS.
      CALL MPLNS (R(I4), Y)
      RETURN
C PREPARE TO USE 2 GUARD DIGITS (BECAUSE SOME CANCELLATION)
   30 CALL MPCLR (R(I2), T+2)
      CALL MPSTR (X, R(I2))
      T = T + 2
      T2 = (T+1)/2
      E = X(2)
C MODIFY EXPONENT TO MAKE RI2 SUFFICIENTLY SMALL THAT
C ERROR WILL BE NEGLIGIBLE
      R(I2+1) = -T2
      CALL MPMULI (R(I2), 4, R(I2))
      CALL MPCIM (1, R(I3))
C COMPUTE NUMBER OF ITERATIONS REQUIRED.  THE CONSTANT
C 2.36... IS ALMOST OPTIMAL.
      B2L = ALOG(FLOAT(B))/ALOG(2E0)
      N = INT(ALOG(FLOAT(T2+1)*B2L*(3E0+FLOAT(T)*B2L))/
     $        ALOG(2E0) - 2.36E0)
C ARITHMETIC-GEOMETRIC MEAN LOOP
      DO 40 I = 1, N
      CALL MPADD (R(I2), R(I3), R(I4))
      CALL MPDIVI (R(I4), 2, R(I4))
      CALL MPMUL (R(I2), R(I3), R(I3))
      CALL MPSQRT (R(I3), R(I2))
C FASTER TO EXCHANGE POINTERS THAN MP NUMBERS
      IT = I3
      I3 = I4
   40 I4 = IT
C CHECK THAT CONVERGENCE OCCURRED
      CALL MPSUB (R(I2), R(I3), R(I4))
      IF ((R(I4).EQ.0).OR.((R(I2+1)-R(I4+1)).GE.(T-3))) GO TO 60
      WRITE (LUN, 50)
   50 FORMAT (47H *** ITERATION FAILED TO CONVERGE IN MPLNGS ***)
      CALL MPERR
C COULD SAVE SOME TIME BY PRECOMPUTING PI AND LN(B)
   60 CALL MPPI (R(I4))
      CALL MPDIV (R(I4), R(I3), R(I3))
      CALL MPDIVI (R(I3), 2, R(I3))
      CALL MPLNI (IABS(B), R(I4))
      CALL MPMULI (R(I4), E+T2, R(I4))
C ALLOW FOR MODIFIED EXPONENT
      CALL MPSUB (R(I4), R(I3), R(I3))
C RESTORE T AND RETURN
      T = T - 2
      CALL MPSTR (R(I3), Y)
      RETURN
      END
      SUBROUTINE MPLNI (N, X)                                           MP035590
C RETURNS MULTIPLE-PRECISION X = LN(N) FOR SMALL POSITIVE
C INTEGER N, TIME IS O(T**2).
C METHOD IS TO USE A RAPIDLY CONVERGING SERIES AND MPL235.
C DIMENSION OF R IN CALLING PROGRAM AT LEAST 3T+8.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(1), TS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, 8)
C CHECK FOR N = 1 AND N .LT. 1
      IF (N-1) 10, 30, 40
   10 WRITE (LUN, 20)
   20 FORMAT (40H *** N NOT POSITIVE IN CALL TO MPLNI ***)
      GO TO 110
C LN(1) = 0
   30 X(1) = 0
      RETURN
C HERE N .GE. 2
   40 IF (N.GT.2) GO TO 50
C N = 2 IS A SPECIAL CASE
      CALL MPL235 (1, 0, 0, X)
      GO TO 170
C HERE N .GE. 3
   50 B2 = MAX0(B, 64)
      IF (N.GT.(3*B2*B2)) GO TO 90
      J = 3
      IA = 0
      N2 = N/2
   60 IF (J.GT.N2) GO TO 70
      IA = IA + 1
      J = 2*J
      GO TO 60
C NOW J = 3*(2**IA) .LE. N .LT. 6*(2**IA)
   70 J = J/3
      IM = N
      IK = 0
      DO 80 I = 3, 6
      N1 = I*J
      IF (IABS(N1-N).GT.IM) GO TO 80
      IM = IABS(N1-N)
      IK = I
   80 CONTINUE
      N1 = IK*J
C NOW N IS CLOSE TO N1 = IK*(2**IA)
C AND IK = 3, 4, 5 OR 6, SO MPL235 GIVES LN(N1).
      IF (IK.EQ.3) CALL MPL235 (IA, 1, 0, X)
      IF (IK.EQ.4) CALL MPL235 (IA+2, 0, 0, X)
      IF (IK.EQ.5) CALL MPL235 (IA, 0, 1, X)
      IF (IK.EQ.6) CALL MPL235 (IA+1, 1, 0, X)
      IF (N.EQ.N1) GO TO 170
C NOW NEED LN(N/N1).
      N2 = N
      CALL MPGCD (N2, N1)
      IP = N2 - N1
      IQ = N2 + N1
C CHECK FOR POSSIBLE INTEGER OVERFLOW
      IF (IQ.GT.14) GO TO 120
   90 WRITE (LUN, 100)
  100 FORMAT (37H *** N TOO LARGE IN CALL TO MPLNI ***)
  110 CALL MPERR
      X(1) = 0
      RETURN
C REDUCE TO LOWEST TERMS
  120 CALL MPGCD (IP, IQ)
      TS = T
      I2 = T + 5
      I3 = I2 + T + 2
      CALL MPCQM (2*IP, IQ, R(I2))
      CALL MPSTR (R(I2), R(I3))
      CALL MPADD (X, R(I3), X)
      I = 1
      IF (IQ.GT.B2) GO TO 130
      IQ2 = IQ**2
      IP2 = IP**2
C LOOP TO SUM SERIES FOR LN(N2/N1)
  130 I = I + 2
      IF (R(I2).EQ.0) GO TO 160
C REDUCE T IF POSSIBLE, DONE IF CAN REDUCE BELOW 2
      T = TS + R(I2+1) + 2
      IF (T.LE.2) GO TO 160
      T = MIN0 (T, TS)
C SPLIT UP CALL TO MPMULQ IF IQ TOO LARGE
      IF (IQ.GT.B2) GO TO 140
      CALL MPMULQ (R(I2), IP2, IQ2, R(I2))
      GO TO 150
C HERE IQ TOO LARGE FOR ONE CALL TO MPMULQ
  140 CALL MPMULQ (R(I2), IP, IQ, R(I2))
      CALL MPMULQ (R(I2), IP, IQ, R(I2))
  150 CALL MPDIVI (R(I2), I, R(I3))
C RESTORE T AND ACCUMULATE SUM
      T = TS
      CALL MPADD2 (R(I3), X, X, X, 0)
      GO TO 130
  160 T = TS
C RETURN IF RESULT ACCURATE TO RELATIVE ERROR 0.01
  170 CALL MPCMR (X, RX)
      IF (ABS(RX-ALOG(FLOAT(N))) .LT. (0.01*RX)) RETURN
      WRITE (LUN, 180)
C THE FOLLOWING MESSAGE MAY INDICATE
C THAT B**(T-1) IS TOO SMALL OR THAT N IS TOO LARGE.
  180 FORMAT (50H *** ERROR OCCURRED IN MPLNI, RESULT INCORRECT ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPLNS (X, Y)                                           MP036636
C RETURNS MP Y = LN(1+X) IF X IS AN MP NUMBER SATISFYING THE
C CONDITION ABS(X) .LT. 1/B, ERROR OTHERWISE.
C USES NEWTONS METHOD TO SOLVE THE EQUATION
C EXP1(-Y) = X, THEN REVERSES SIGN OF Y.
C (HERE EXP1(Y) = EXP(Y) - 1 IS COMPUTED USING MPEXP1).
C TIME IS O(SQRT(T).M(T)) AS FOR MPEXP1, SPACE = 5T+12.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1), TS, TS2, TS3
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (5, 12)
      I2 = 2*T + 7
      I3 = I2 + T + 2
      I4 = I3 + T + 2
C CHECK FOR X = 0 EXACTLY
      IF (X(1).NE.0) GO TO 10
      Y(1) = 0
      RETURN
C CHECK THAT ABS(X) .LT. 1/B
   10 IF ((X(2)+1).LE.0) GO TO 30
      WRITE (LUN, 20)
   20 FORMAT (41H *** ABS(X) .GE. 1/B IN CALL TO MPLNS ***)
      CALL MPERR
      Y(1) = 0
      RETURN
C SAVE T AND GET STARTING APPROXIMATION TO -LN(1+X)
   30 TS = T
      CALL MPSTR (X, R(I3))
      CALL MPDIVI (X, 4, R(I2))
      CALL MPADDQ (R(I2), -1, 3, R(I2))
      CALL MPMUL (X, R(I2), R(I2))
      CALL MPADDQ (R(I2), 1, 2, R(I2))
      CALL MPMUL (X, R(I2), R(I2))
      CALL MPADDI (R(I2), -1, R(I2))
      CALL MPMUL (X, R(I2), Y)
C START NEWTON ITERATION USING SMALL T, LATER INCREASE
      T = MAX0 (5, 13-2*B)
      IF (T.GT.TS) GO TO 80
      IT0 = (T+5)/2
   40 CALL MPEXP1 (Y, R(I4))
      CALL MPMUL (R(I3), R(I4), R(I2))
      CALL MPADD (R(I4), R(I2), R(I4))
      CALL MPADD (R(I3), R(I4), R(I4))
      CALL MPSUB (Y, R(I4), Y)
      IF (T.GE.TS) GO TO 60
C FOLLOWING LOOP COMPUTES NEXT VALUE OF T TO USE.
C BECAUSE NEWTONS METHOD HAS 2ND ORDER CONVERGENCE,
C WE CAN ALMOST DOUBLE T EACH TIME.
      TS3 = T
      T = TS
   50 TS2 = T
      T = (T+IT0)/2
      IF (T.GT.TS3) GO TO 50
      T = TS2
      GO TO 40
C CHECK THAT NEWTON ITERATION WAS CONVERGING AS EXPECTED
   60 IF ((R(I4).EQ.0).OR.((2*R(I4+1)).LE.(IT0-T))) GO TO 80
      WRITE (LUN, 70)
   70 FORMAT (50H *** ERROR OCCURRED IN MPLNS, NEWTON ITERATION NOT,
     $        24H CONVERGING PROPERLY ***)
      CALL MPERR
C REVERSE SIGN OF Y AND RETURN
   80 Y(1) = -Y(1)
      T = TS
      RETURN
      END
      LOGICAL FUNCTION MPLT (X, Y)                                      MP037283
C RETURNS LOGICAL VALUE OF (X .LT. Y) FOR MP X AND Y.
      INTEGER X(1), Y(1)
      MPLT = (MPCOMP(X,Y) .LT. 0)
      RETURN
      END
      SUBROUTINE MPL235 (I, J, K, X)                                    MP037310
C RETURNS MP X = LN((2**I)*(3**J)*(5**K)), FOR INTEGER I, J AND K.
C THE METHOD REQUIRES TIME O(T**2).  LN(81/80), LN(25/24) AND
C LN(16/15) ARE CALCULATED FIRST.  MPL235 COULD BE SPEEDED
C UP IF THESE CONSTANTS WERE PRECOMPUTED AND SAVED.
C ASSUMED THAT I, J AND K NOT TOO LARGE.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 3T+8
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(2), C(3), D(3), D2, TS, Q
      DATA D(1), D(2), D(3) /161, 49, 31/
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, 8)
      X(1) = 0
      IF (MAX0(IABS(I), IABS(J), IABS(K)) .LT.
     $    (MAX0(B*B, 4096)/9)) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (45H *** I, J OR K TOO LARGE IN CALL TO MPLNI ***)
      CALL MPERR
      RETURN
   20 B2 = 2*MAX0(B, 64)
      I2 = T + 5
      I3 = I2 + T + 2
      C(1) = 3*I + 5*J + 7*K
      C(2) = 5*I + 8*J + 12*K
      C(3) = 7*I + 11*J + 16*K
      TS = T
      DO 60 Q = 1, 3
      CALL MPCQM (2*C(Q), D(Q), R(I2))
      CALL MPSTR (R(I2), R(I3))
      CALL MPADD (X, R(I3), X)
      IF (D(Q).LE.B2) D2 = D(Q)**2
      N = 1
   30 N = N + 2
      IF (R(I2).EQ.0) GO TO 60
C REDUCE T IF POSSIBLE
      T = TS + R(I2+1) + 2 - X(2)
      IF (T.LE.2) GO TO 60
      T = MIN0 (T, TS)
C IF D(Q)**2 NOT REPRESENTABLE AS AN INTEGER, THE FOLLOWING
C DIVISION MUST BE SPLIT UP
      IF (D(Q).GT.B2) GO TO 40
      CALL MPDIVI (R(I2), D2, R(I2))
      GO TO 50
   40 CALL MPDIVI (R(I2), D(Q), R(I2))
      CALL MPDIVI (R(I2), D(Q), R(I2))
   50 CALL MPDIVI (R(I2), N, R(I3))
      T = TS
      CALL MPADD2 (R(I3), X, X, X, 0)
      GO TO 30
   60 T = TS
      RETURN
      END
      SUBROUTINE MPMAX (X, Y, Z)                                        MP037840
C SETS Z = MAX (X, Y) WHERE X, Y AND Z ARE MULTIPLE-PRECISION
      INTEGER X(1), Y(1), Z(1)
      IF (MPCOMP (X, Y) .GE. 0) GO TO 10
C HERE X .LT. Y
      CALL MPSTR (Y, Z)
      RETURN
C HERE X .GE. Y
   10 CALL MPSTR (X, Z)
      RETURN
      END
      SUBROUTINE MPMAXR (X)                                             MP037956
C SETS X TO THE LARGEST POSSIBLE POSITIVE MP NUMBER
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3)
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      IT = B - 1
C SET FRACTION DIGITS TO B-1
      DO 10 I = 1, T
   10 X(I+2) = IT
C SET SIGN AND EXPONENT
      X(1) = 1
      X(2) = M
      RETURN
      END
      FUNCTION MPMEXA (X)                                               MP038053
C RETURNS THE MAXIMUM ALLOWABLE EXPONENT OF MP NUMBERS (THE THIRD
C WORD OF COMMON).  X IS A DUMMY MP ARGUMENT.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      MPMEXA = M
      RETURN
      END
      SUBROUTINE MPMEXB (I, X)                                          MP038073
C SETS THE MAXIMUM ALLOWABLE EXPONENT OF MP NUMBERS (I.E. THE
C THIRD WORD OF COMMON) TO I.
C I SHOULD BE GREATER THAN T, AND 4*I SHOULD BE REPRESENTABLE
C AS A SINGLE-PRECISION INTEGER.
C X IS A DUMMY MP ARGUMENT (AUGMENT EXPECTS ONE).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
      M = I
C CHECK LEGALITY OF M.  IF TOO LARGE, 4*M MAY OVERFLOW AND TEST .LE. 0
      IF ((M.GT.T).AND.((4*M).GT.0)) RETURN
      WRITE (LUN, 10)
   10 FORMAT (44H *** ATTEMPT TO SET ILLEGAL MAXIMUM EXPONENT,
     $        22H IN CALL TO MPMEXB ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPMIN (X, Y, Z)                                        MP038120
C SETS Z = MIN (X, Y) WHERE X, Y AND Z ARE MULTIPLE-PRECISION
      INTEGER X(1), Y(1), Z(1)
      IF (MPCOMP (X, Y) .GE. 0) GO TO 10
C HERE X .LT. Y
      CALL MPSTR (X, Z)
      RETURN
C HERE X .GE. Y
   10 CALL MPSTR (Y, Z)
      RETURN
      END
      SUBROUTINE MPMINR (X)                                             MP038240
C SETS X TO THE SMALLEST POSITIVE NORMALIZED MP NUMBER
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3)
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
C SET FRACTION DIGITS TO ZERO
      DO 10 I = 2, T
   10 X(I+2) = 0
C SET SIGN, EXPONENT AND FIRST FRACTION DIGIT
      X(1) = 1
      X(2) = -M
      X(3) = 1
      RETURN
      END
      SUBROUTINE MPMLP (U, V, W, J)                                     MP038400
C PERFORMS INNER MULTIPLICATION LOOP FOR MPMUL
C NOTE THAT CARRIES ARE NOT PROPAGATED IN INNER LOOP,
C WHICH SAVES TIME AT THE EXPENSE OF SPACE.
      INTEGER U(1), V(1), W
      DO 10 I = 1, J
   10 U(I) = U(I) + W*V(I)
      RETURN
      END
      SUBROUTINE MPMUL (X, Y, Z)                                        MP038500
C MULTIPLIES X AND Y, RETURNING RESULT IN Z, FOR MP X, Y AND Z.
C THE SIMPLE O(T**2) ALGORITHM IS USED, WITH
C FOUR GUARD DIGITS AND R*-ROUNDING.
C ADVANTAGE IS TAKEN OF ZERO DIGITS IN X, BUT NOT IN Y.
C ASYMPTOTICALLY FASTER ALGORITHMS ARE KNOWN (SEE KNUTH,
C VOL. 2), BUT ARE DIFFICULT TO IMPLEMENT IN FORTRAN IN AN
C EFFICIENT AND MACHINE-INDEPENDENT MANNER.
C IN COMMENTS TO OTHER MP ROUTINES, M(T) IS THE TIME
C TO PERFORM T-DIGIT MP MULTIPLICATION.   THUS
C M(T) = O(T**2) WITH THE PRESENT VERSION OF MPMUL,
C BUT M(T) = O(T.LOG(T).LOG(LOG(T))) IS THEORETICALLY POSSIBLE.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3), Y(3), Z(1), RS, RE, XI, C, RI
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (1, 4)
      I2 = T + 4
      I2P = I2 + 1
C FORM SIGN OF PRODUCT
      RS = X(1)*Y(1)
      IF (RS.NE.0) GO TO 10
C SET RESULT TO ZERO
      Z(1) = 0
      RETURN
C FORM EXPONENT OF PRODUCT
   10 RE = X(2) + Y(2)
C CLEAR ACCUMULATOR
      DO 20 I = 1, I2
   20 R(I) = 0
C PERFORM MULTIPLICATION
      C = 8
      DO 40 I = 1, T
      XI = X(I+2)
C FOR SPEED, PUT THE NUMBER WITH MANY ZEROS FIRST
      IF (XI.EQ.0) GO TO 40
      CALL MPMLP (R(I+1), Y(3), XI, MIN0 (T, I2 - I))
      C = C - 1
      IF (C.GT.0) GO TO 40
C CHECK FOR LEGAL BASE B DIGIT
      IF ((XI.LT.0).OR.(XI.GE.B)) GO TO 90
C PROPAGATE CARRIES AT END AND EVERY EIGHTH TIME,
C FASTER THAN DOING IT EVERY TIME.
      DO 30 J = 1, I2
      J1 = I2P - J
      RI = R(J1) + C
      IF (RI.LT.0) GO TO 70
      C = RI/B
   30 R(J1) = RI - B*C
      IF (C.NE.0) GO TO 90
      C = 8
   40 CONTINUE
      IF (C.EQ.8) GO TO 60
      IF ((XI.LT.0).OR.(XI.GE.B)) GO TO 90
      C = 0
      DO 50 J = 1, I2
      J1 = I2P - J
      RI = R(J1) + C
      IF (RI.LT.0) GO TO 70
      C = RI/B
   50 R(J1) = RI - B*C
      IF (C.NE.0) GO TO 90
C NORMALIZE AND ROUND RESULT
   60 CALL MPNZR (RS, RE, Z, 0)
      RETURN
   70 WRITE (LUN, 80)
   80 FORMAT (47H *** INTEGER OVERFLOW IN MPMUL, B TOO LARGE ***)
      GO TO 110
   90 WRITE (LUN, 100)
  100 FORMAT (43H *** ILLEGAL BASE B DIGIT IN CALL TO MPMUL,,
     $        33H POSSIBLE OVERWRITING PROBLEM ***)
  110 CALL MPERR
      Z(1) = 0
      RETURN
      END
      SUBROUTINE MPMULI (X, IY, Z)                                      MP039250
C MULTIPLIES MP X BY SINGLE-PRECISION INTEGER IY GIVING MP Z.
C THIS IS FASTER THAN USING MPMUL.  RESULT IS ROUNDED.
C MULTIPLICATION BY 1 MAY BE USED TO NORMALIZE A NUMBER
C EVEN IF THE LAST DIGIT IS B.
      INTEGER X(1), Z(1)
      CALL MPMUL2 (X, IY, Z, 0)
      RETURN
      END
      SUBROUTINE MPMULQ (X, I, J, Y)                                    MP039350
C MULTIPLIES MP X BY I/J, GIVING MP Y
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
      IF (J.NE.0) GO TO 20
      CALL MPCHK (1, 4)
      WRITE (LUN, 10)
   10 FORMAT (45H *** ATTEMPTED DIVISION BY ZERO IN MPMULQ ***)
      CALL MPERR
      GO TO 30
   20 IF (I.NE.0) GO TO 40
   30 Y(1) = 0
      RETURN
C REDUCE TO LOWEST TERMS
   40 IS = I
      JS = J
      CALL MPGCD (IS, JS)
      IF (IABS(IS).EQ.1) GO TO 50
      CALL MPDIVI (X, JS, Y)
      CALL MPMUL2 (Y, IS, Y, 0)
      RETURN
C HERE IS = +-1
   50 CALL MPDIVI (X, IS*JS, Y)
      RETURN
      END
      SUBROUTINE MPMUL2 (X, IY, Z, TRUNC)                               MP039606
C MULTIPLIES MP X BY SINGLE-PRECISION INTEGER IY GIVING MP Z.
C MULTIPLICATION BY 1 MAY BE USED TO NORMALIZE A NUMBER
C EVEN IF SOME DIGITS ARE GREATER THAN B-1.
C RESULT IS ROUNDED IF TRUNC.EQ.0, OTHERWISE TRUNCATED.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(6), X(2), Z(2), TRUNC, RE, RS
      INTEGER C, C1, C2, RI, T1, T3, T4
      RS = X(1)
      IF (RS.EQ.0) GO TO 10
      J = IY
      IF (J) 20, 10, 50
C RESULT ZERO
   10 Z(1) = 0
      RETURN
   20 J = -J
      RS = -RS
C CHECK FOR MULTIPLICATION BY B
      IF (J.NE.B) GO TO 50
      IF (X(2).LT.M) GO TO 40
      CALL MPCHK (1, 4)
      WRITE (LUN, 30)
   30 FORMAT (36H *** OVERFLOW OCCURRED IN MPMUL2 ***)
      CALL MPOVFL (Z)
      RETURN
   40 CALL MPSTR (X, Z)
      Z(1) = RS
      Z(2) = X(2) + 1
      RETURN
C SET EXPONENT TO EXPONENT(X) + 4
   50 RE = X(2) + 4
C FORM PRODUCT IN ACCUMULATOR
      C = 0
      T1 = T + 1
      T3 = T + 3
      T4 = T + 4
C IF J*B NOT REPRESENTABLE AS AN INTEGER WE HAVE TO SIMULATE
C DOUBLE-PRECISION MULTIPLICATION.
      IF (J.GE.MAX0(8*B, 32767/B)) GO TO 110
      DO 60 IJ = 1, T
      I = T1 - IJ
      RI = J*X(I+2) + C
      C = RI/B
   60 R(I+4) = RI - B*C
C CHECK FOR INTEGER OVERFLOW
      IF (RI.LT.0) GO TO 130
C HAVE TO TREAT FIRST FOUR WORDS OF R SEPARATELY
      DO 70 IJ = 1, 4
      I = 5 - IJ
      RI = C
      C = RI/B
   70 R(I) = RI - B*C
      IF (C.EQ.0) GO TO 100
C HAVE TO SHIFT RIGHT HERE AS CARRY OFF END
   80 DO 90 IJ = 1, T3
      I = T4 - IJ
   90 R(I+1) = R(I)
      RI = C
      C = RI/B
      R(1) = RI - B*C
      RE = RE + 1
      IF (C) 130, 100, 80
C NORMALIZE AND ROUND OR TRUNCATE RESULT
  100 CALL MPNZR (RS, RE, Z, TRUNC)
      RETURN
C HERE J IS TOO LARGE FOR SINGLE-PRECISION MULTIPLICATION
  110 J1 = J/B
      J2 = J - J1*B
C FORM PRODUCT
      DO 120 IJ = 1, T4
      C1 = C/B
      C2 = C - B*C1
      I = T1 - IJ
      IX = 0
      IF (I.GT.0) IX = X(I+2)
      RI = J2*IX + C2
      IS = RI/B
      C = J1*IX + C1 + IS
  120 R(I+4) = RI - B*IS
      IF (C) 130, 100, 80
C CAN ONLY GET HERE IF INTEGER OVERFLOW OCCURRED
  130 CALL MPCHK (1, 4)
      WRITE (LUN, 140)
  140 FORMAT (48H *** INTEGER OVERFLOW IN MPMUL2, B TOO LARGE ***)
      CALL MPERR
      GO TO 10
      END
      LOGICAL FUNCTION MPNE (X, Y)                                      MP040463
C RETURNS LOGICAL VALUE OF (X .NE. Y) FOR MP X AND Y.
      INTEGER X(1), Y(1)
      MPNE = (MPCOMP(X,Y) .NE. 0)
      RETURN
      END
      SUBROUTINE MPNEG (X, Y)                                           MP040490
C SETS Y = -X FOR MP NUMBERS X AND Y
      INTEGER X(1), Y(1)
      CALL MPSTR (X, Y)
      Y(1) = -Y(1)
      RETURN
      END
      SUBROUTINE MPNZR (RS, RE, Z, TRUNC)                               MP040570
C ASSUMES LONG (I.E. (T+4)-DIGIT) FRACTION IN
C R, SIGN = RS, EXPONENT = RE.  NORMALIZES,
C AND RETURNS MP RESULT IN Z.  INTEGER ARGUMENTS RS AND RE
C ARE NOT PRESERVED. R*-ROUNDING IS USED IF TRUNC.EQ.0
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(6), Z(2), RE, RS, TRUNC, B2
      I2 = T + 4
      IF (RS.NE.0) GO TO 20
C STORE ZERO IN Z
   10 Z(1) = 0
      RETURN
C CHECK THAT SIGN = +-1
   20 IF (IABS(RS).LE.1) GO TO 40
      WRITE (LUN, 30)
   30 FORMAT (43H *** SIGN NOT 0, +1 OR -1 IN CALL TO MPNZR,,
     $        33H POSSIBLE OVERWRITING PROBLEM ***)
      CALL MPERR
      GO TO 10
C LOOK FOR FIRST NONZERO DIGIT
   40 DO 50 I = 1, I2
      IS = I - 1
      IF (R(I).GT.0) GO TO 60
   50 CONTINUE
C FRACTION ZERO
      GO TO 10
   60 IF (IS.EQ.0) GO TO 90
C NORMALIZE
      RE = RE - IS
      I2M = I2 - IS
      DO 70 J = 1, I2M
      K = J + IS
   70 R(J) = R(K)
      I2P = I2M + 1
      DO 80 J = I2P, I2
   80 R(J) = 0
C CHECK TO SEE IF TRUNCATION IS DESIRED
   90 IF (TRUNC.NE.0) GO TO 150
C SEE IF ROUNDING NECESSARY
C TREAT EVEN AND ODD BASES DIFFERENTLY
      B2 = B/2
      IF ((2*B2).NE.B) GO TO 130
C B EVEN.  ROUND IF R(T+1).GE.B2 UNLESS R(T) ODD AND ALL ZEROS
C AFTER R(T+2).
      IF (R(T+1) - B2) 150, 100, 110
  100 IF (MOD(R(T),2).EQ.0) GO TO 110
      IF ((R(T+2)+R(T+3)+R(T+4)).EQ.0) GO TO 150
C ROUND
  110 DO 120 J = 1, T
      I = T + 1 - J
      R(I) = R(I) + 1
      IF (R(I).LT.B) GO TO 150
  120 R(I) = 0
C EXCEPTIONAL CASE, ROUNDED UP TO .10000...
      RE = RE + 1
      R(1) = 1
      GO TO 150
C ODD BASE, ROUND IF R(T+1)... .GT. 1/2
  130 DO 140 I = 1, 4
      IT = T + I
      IF (R(IT) - B2) 150, 140, 110
  140 CONTINUE
C CHECK FOR OVERFLOW
  150 IF (RE.LE.M) GO TO 170
      WRITE (LUN, 160)
  160 FORMAT (35H *** OVERFLOW OCCURRED IN MPNZR ***)
      CALL MPOVFL (Z)
      RETURN
C CHECK FOR UNDERFLOW
  170 IF (RE.LT.(-M)) GO TO 190
C STORE RESULT IN Z
      Z(1) = RS
      Z(2) = RE
      DO 180 I = 1, T
  180 Z(I+2) = R(I)
      RETURN
C UNDERFLOW HERE
  190 CALL MPUNFL (Z)
      RETURN
      END
      SUBROUTINE MPOUT (X, C, P, N)                                     MP041380
C CONVERTS MULTIPLE-PRECISION X TO FP.N FORMAT IN C,
C WHICH MAY BE PRINTED UNDER PA1 FORMAT.  NOTE THAT
C N = -1 IS ALLOWED, AND EFFECTIVELY GIVES IP FORMAT.
C DIGITS AFTER THE DECIMAL POINT ARE BLANKED OUT IF
C THEY COULD NOT BE SIGNIFICANT.
C EFFICIENCY IS HIGHER IF B IS A POWER OF 10 THAN IF NOT.
C DIMENSION OF C MUST BE AT LEAST P.
C C IS AN INTEGER ARRAY, P AND N ARE INTEGERS.
C DIMENSION OF R IN COMMON MUST BE AT LEAST 3T+11
      INTEGER X(1), C(1), P
      CALL MPOUT2 (X, C, P, N, 10)
      RETURN
      END
      SUBROUTINE MPOUTE (X, C, J, P)                                    MP041526
C ASSUMES X IS AN MP NUMBER AND C AN INTEGER ARRAY OF DIMENSION AT
C LEAST P .GE. 4.  ON RETURN J IS THE EXPONENT (TO BASE TEN) OF X
C AND THE FRACTION IS IN C, READY TO BE PRINTED IN A1 FORMAT.
C FOR EXAMPLE, WE COULD PRINT J AND C IN I10, 1X, PA1 FORMAT.
C THE FRACTION HAS ONE PLACE BEFORE DECIMAL POINT AND P-3 AFTER.
C J AND P ARE INTEGERS.    SPACE = 6T+14
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), C(1), P
      DATA IBL /1H /, IMIN /1H-/
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (6, 14)
      IF (P.GE.4) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (35H *** P .LT. 4 IN CALL TO MPOUTE ***)
      CALL MPERR
      RETURN
   20 I2 = 5*T + 13
      CALL MPCMEF (X, J, R(I2))
      CALL MPOUT (R(I2), C, P, P-3)
C SEE IF OUTPUT OF MPOUT WAS ROUNDED UP TO TEN
      IF ((C(1).EQ.IBL).OR.(C(1).EQ.IMIN)) RETURN
C IT WAS, SO ADD 1 TO J AND CONVERT SIGN TO MP
      J = J + 1
C AVOID POSSIBLY UNSAFE REFERENCE (SEE SOFTWARE PRACTICE
C AND EXPERIENCE, VOL. 4, 359-378).
      IR = R(I2)
      CALL MPCIM (IR, R(I2))
      CALL MPOUT (R(I2), C, P, P-3)
      RETURN
      END
      SUBROUTINE MPOUTF (X, P, N, IFORM, ERR)                           MP041783
C WRITES MP NUMBER X ON LOGICAL UNIT LUN (FOURTH WORD OF COMMON)
C IN FORMAT IFORM AFTER CONVERTING TO FP.N DECIMAL REPRESENTATION
C USING ROUTINE MPOUT. FOR FURTHER DETAILS SEE COMMENTS IN MPOUT.
C IFORM SHOULD CONTAIN A FORMAT WHICH ALLOWS FOR OUTPUT OF P
C WORDS IN A1 FORMAT, PLUS ANY DESIRED HEADINGS, SPACING ETC.
C E.G. 24H(8H1HEADING/(11X,100A1))
C ERR RETURNED AS TRUE IF P NOT POSITIVE, OTHERWISE FALSE.
C SPACE REQUIRED 3T+P+11 WORDS.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), IFORM(1), P
      LOGICAL ERR
      ERR = .TRUE.
C RETURN WITH ERROR FLAG SET IF OUTPUT FIELD WIDTH P NOT POSITIVE
      IF (P.LE.0) RETURN
C CHECK THAT ENOUGH SPACE IS AVAILABLE
      CALL MPCHK (3, P+11)
      I2 = 3*T + 12
C CONVERT X TO DECIMAL FORM
      CALL MPOUT (X, R(I2), P, N)
C AND WRITE ON UNIT LUN WITH FORMAT IFORM
      CALL MPIO (R(I2), P, LUN, IFORM, ERR)
      RETURN
      END
      SUBROUTINE MPOUT2 (X, C, P, N, NB)                                MP041850
C SAME AS MPOUT EXCEPT THAT OUTPUT REPRESENTATION IS IN
C BASE NB, WHERE 2 .LE. NB .LE. 16,
C EG NB = 8 GIVES OCTAL OUTPUT, NB = 16 GIVES HEXADECIMAL.
C OUTPUT DIGITS ARE 0123456789ABCDEF.
C X IS AN MP NUMBER, C AN INTEGER ARRAY, P, N AND NB ARE INTEGERS.
C DIMENSION OF C MUST BE AT LEAST P, DIMENSION OF R
C IN CALLING PROGRAM MUST BE AT LEAST 3T+11
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), C(1), NUM(20), P, TP
      DATA NUM(1), NUM(2), NUM(3) / 1H0, 1H1, 1H2 /
      DATA NUM(4), NUM(5), NUM(6) / 1H3, 1H4, 1H5 /
      DATA NUM(7), NUM(8), NUM(9) / 1H6, 1H7, 1H8 /
      DATA NUM(10), NUM(11), NUM(12) / 1H9, 1HA, 1HB /
      DATA NUM(13), NUM(14), NUM(15) / 1HC, 1HD, 1HE /
      DATA NUM(16), NUM(17), NUM(18) / 1HF, 1H , 1H. /
      DATA NUM(19), NUM(20) / 1H*, 1H- /
C CHECK LEGALITY OF B, T, M, MXR AND LUN
      CALL MPCHK (3, 11)
C CHECK LEGALITY OF P, N AND NB
      IF ((N.GE.(-1)).AND.(P.GT.N).AND.(P.GT.0).AND.
     $    (NB.GT.1).AND.(NB.LE.16)) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (30H *** PARAMETERS P, N AND/OR NB,
     $        41H ILLEGAL IN CALL TO SUBROUTINE MPOUT2 ***)
      CALL MPERR
      RETURN
C COMPUTE DISPLACEMENTS, MOVE X
   20 I2 = T + 6
      I3 = I2 + T + 3
      CALL MPSTR (X, R(I2))
      NP = P - N
      IP = NP - 1
C COMPUTE POWER OF NB WHICH WE CAN SAFELY MULTIPLY AND
C DIVIDE BY (THIS SAVES TIME).
      IB = MAX0(7*B*B, 32767)/NB
      TP = NB
      ITP = 1
   30 IF ((TP.GT.IB).OR.(TP.EQ.B)) GO TO 40
      TP = TP*NB
      ITP = ITP + 1
      GO TO 30
C PUT FORMATTED ZERO IN C
   40 DO 50 I = 1, P
      C(I) = NUM(17)
      IF (I.GE.IP) C(I) = NUM(1)
      IF (I.EQ.NP) C(I) = NUM(18)
   50 CONTINUE
C GET SIGN OF X, CHECK FOR ZERO
      IS = R(I2)
      IF (IS.EQ.0) RETURN
      R(I2) = 1
C COMPUTE MAXIMUM NUMBER OF NONZERO DIGITS WHICH WE CAN
C MEANINGFULLY GIVE AFTER DECIMAL POINT.
      NMAX = MIN1 (FLOAT(N)+0.001E0, AMAX1 (0E0,
     $       FLOAT(T-R(I2+1))*ALOG(FLOAT(B))/ALOG(FLOAT(NB))+0.001E0))
C WORK WITH ONE GUARD DIGIT
      CALL MPCLR (R(I2), T+1)
      T = T + 1
C COMPUTE ROUNDING CONSTANT
      CALL MPCQM (1, 2, R(I3))
      IF (NMAX.LE.0) GO TO 70
      JP = 1
      DO 60 I = 1, NMAX
      JP = NB*JP
      IF ((JP.LE.IB).AND.(JP.NE.B).AND.(I.LT.NMAX)) GO TO 60
      CALL MPDIVI (R(I3), JP, R(I3))
      JP = 1
   60 CONTINUE
C ADD ROUNDING CONSTANT TO ABS(X), TRUNCATING RESULT
   70 CALL MPADD2 (R(I2), R(I3), R(I2), R(I3), 1)
C IP PLACES BEFORE POINT, SO DIVIDE BY NB**IP
      IF (IP.LE.0) GO TO 90
      JP = 1
      DO 80 I = 1, IP
      JP = NB*JP
      IF ((JP.LE.IB).AND.(I.LT.IP)) GO TO 80
      CALL MPDIVI (R(I2), JP, R(I2))
      JP = 1
   80 CONTINUE
   90 IZ = 0
C CHECK THAT NUMBER IS LESS THAN ONE
      IF (R(I2+1).GT.0) GO TO 170
      IF (IP.LE.0) GO TO 140
C PUT DIGITS BEFORE POINT IN
      JD = 1
      DO 130 I = 1, IP
      IF (JD.GT.1) GO TO 120
      IF ((I+ITP).LE.(IP+1)) GO TO 100
C MULTIPLY BY NB, TRUNCATING RESULT
      CALL MPMUL2 (R(I2), NB, R(I2), 1)
      JD = NB
      GO TO 110
C HERE WE CAN MULTIPLY BY A POWER OF NB TO SAVE TIME
  100 CALL MPMUL2 (R(I2), TP, R(I2), 1)
      JD = TP
C GET INTEGER PART
  110 CALL MPCMI (R(I2), JP)
C AND FRACTIONAL PART
      CALL MPCMF (R(I2), R(I2))
  120 JD = JD/NB
C GET NEXT DECIMAL DIGIT
      J = JP/JD
      JP = JP - J*JD
      ISZ = IZ
      IF ((J.GT.0).OR.(I.EQ.IP)) IZ = 1
      IF (IZ.GT.0) C(I) = NUM(J+1)
      IF ((IZ.EQ.ISZ).OR.(IS.GT.0)) GO TO 130
      IF (I.EQ.1) GO TO 170
      C(I-1) = NUM(20)
  130 CONTINUE
  140 IF (NMAX.LE.0) GO TO 190
C PUT IN DIGITS AFTER DECIMAL POINT
      JD = 1
      DO 160 I = 1, NMAX
      IF (JD.GT.1) GO TO 150
      CALL MPMUL2 (R(I2), TP, R(I2), 1)
      CALL MPCMI (R(I2), JP)
      CALL MPCMF (R(I2), R(I2))
      JD = TP
  150 JD = JD/NB
      J = JP/JD
      JP = JP - J*JD
      I1 = NP + I
  160 C(I1) = NUM(J+1)
      GO TO 190
C ERROR OCCURRED, RETURN ASTERISKS.
  170 DO 180 I = 1, P
  180 C(I) = NUM(19)
C RESTORE T
  190 T = T - 1
C BLANK OUT ANY NONSIGNIFICANT TRAILING ZEROS
      IF ((NMAX.GE.N).OR.(C(1).EQ.NUM(19))) RETURN
      I1 = NP + NMAX + 1
      DO 200 I = I1, P
  200 C(I) = NUM(17)
      RETURN
      END
      SUBROUTINE MPOVFL (X)                                             MP043240
C CALLED ON MULTIPLE-PRECISION OVERFLOW, IE WHEN THE
C EXPONENT OF MP NUMBER X WOULD EXCEED M.
C AT PRESENT EXECUTION IS TERMINATED WITH AN ERROR MESSAGE
C AFTER CALLING MPMAXR(X), BUT IT WOULD BE POSSIBLE TO RETURN,
C POSSIBLY UPDATING A COUNTER AND TERMINATING EXECUTION AFTER
C A PRESET NUMBER OF OVERFLOWS.  ACTION COULD EASILY BE DETERMINED
C BY A FLAG IN LABELLED COMMON.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C M MAY HAVE BEEN OVERWRITTEN, SO CHECK B, T, M ETC.
      CALL MPCHK (1, 4)
C SET X TO LARGEST POSSIBLE POSITIVE NUMBER
      CALL MPMAXR (X)
      WRITE (LUN, 10)
   10 FORMAT (45H *** CALL TO MPOVFL, MP OVERFLOW OCCURRED ***)
C TERMINATE EXECUTION BY CALLING MPERR
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPPACK (X, Y)                                          MP043450
C ASSUMES THAT X IS AN MP NUMBER STORED AS USUAL IN AN INTEGER
C ARRAY OF DIMENSION AT LEAST T+2, AND Y IS AN INTEGER ARRAY
C OF DIMENSION AT LEAST INT((T+3)/2).
C X IS STORED IN A COMPACT FORMAT IN Y, AND MAY BE RETRIEVED
C BY CALLING MPUNPK (Y, X).
C MPPACK AND MPUNPK ARE USEFUL IF SPACE IS CRITICAL, FOR EXAMPLE
C WHEN WORKING WITH LARGE ARRAYS OF MP NUMBERS.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2)
      IS = X(1)
      IF (IS.NE.0) GO TO 10
C X ZERO HERE
      Y(2) = 0
      RETURN
C X NONZERO.  FIRST MOVE EXPONENT TO Y(1).
   10 Y(1) = X(2)
      J = T/2
C NOW PACK TWO DIGITS OF X IN EACH WORD OF Y.
      DO 20 I = 1, J
   20 Y(I+1) = B*X(2*I+1) + X(2*I+2)
C FIX UP LAST DIGIT IF T ODD, AND CORRECT SIGN.
      IF ((2*J).LT.T) Y(J+2) = B*X(T+2)
      Y(2) = IS*Y(2)
      RETURN
      END
      SUBROUTINE MPPI (X)                                               MP043720
C SETS MP X = PI TO THE AVAILABLE PRECISION.
C USES PI/4 = 4.ARCTAN(1/5) - ARCTAN(1/239).
C TIME IS O(T**2).
C DIMENSION OF R MUST BE AT LEAST 3T+8
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, 8)
C ALLOW SPACE FOR MPART1
      I2 = 2*T + 7
      CALL MPART1 (5, R(I2))
      CALL MPMULI (R(I2), 4, R(I2))
      CALL MPART1 (239, X)
      CALL MPSUB (R(I2), X, X)
      CALL MPMULI (X, 4, X)
C RETURN IF ERROR IS LESS THAN 0.01
      CALL MPCMR (X, RX)
      IF (ABS(RX-3.1416) .LT. 0.01) RETURN
      WRITE (LUN, 10)
C FOLLOWING MESSAGE MAY INDICATE THAT B**(T-1) IS TOO SMALL
   10 FORMAT (49H *** ERROR OCCURRED IN MPPI, RESULT INCORRECT ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPPIGL (PI)                                            MP043980
C SETS MP PI = 3.14159... TO THE AVAILABLE PRECISION.
C USES THE GAUSS-LEGENDRE ALGORITHM.
C THIS METHOD REQUIRES TIME O(LN(T)M(T)), SO IT IS SLOWER
C THAN MPPI IF M(T) = O(T**2), BUT WOULD BE FASTER FOR
C LARGE T IF A FASTER MULTIPLICATION ALGORITHM WERE USED
C (SEE COMMENTS IN MPMUL).
C FOR A DESCRIPTION OF THE METHOD, SEE - MULTIPLE-PRECISION
C ZERO-FINDING AND THE COMPLEXITY OF ELEMENTARY FUNCTION
C EVALUATION (BY R. P. BRENT), IN ANALYTIC COMPUTATIONAL
C COMPLEXITY (EDITED BY J. F. TRAUB), ACADEMIC PRESS, 1976,
C 151-176.  DIMENSION OF R MUST BE AT LEAST 6T+14
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), PI(1), R1, R2
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (6, 14)
C MPSQRT AND MPDIV REQUIRE SPACE 4T+10, BUT CAN OVERLAP
      I2 = 3*T + 9
      I3 = I2 + T + 2
      I4 = I3 + T + 2
      CALL MPCIM (1, PI(1))
      CALL MPCQM (1, 2, R(I4))
      CALL MPSQRT (R(I4), R(I4))
      CALL MPCQM (1, 4, R(I3))
      IX = 1
   10 CALL MPSTR (PI(1), R(I2))
      CALL MPADD (PI(1), R(I4), PI(1))
      CALL MPDIVI (PI(1), 2, PI(1))
      CALL MPMUL (R(I2), R(I4), R(I4))
      CALL MPSUB (PI(1), R(I2), R(I2))
      CALL MPMUL (R(I2), R(I2), R(I2))
      CALL MPMULI (R(I2), IX, R(I2))
      CALL MPSUB (R(I3), R(I2), R(I3))
C SAVE ARRAY ELEMENTS WHICH WILL BE OVERWRITTEN BY MPSQRT
      R1 = R(I2)
      R2 = R(I2+1)
      CALL MPSQRT (R(I4), R(I4))
      IX = 2*IX
C CHECK FOR CONVERGENCE
      IF ((R1.NE.0).AND.(R2.GE.(-T))) GO TO 10
      CALL MPMUL (PI(1), R(I4), PI(1))
      CALL MPDIV (PI(1), R(I3), PI(1))
      RETURN
      END
      SUBROUTINE MPPOLY (X, Y, IC, N)                                   MP044430
C SETS Y = IC(1) + IC(2)*X + ... + IC(N)*X**(N-1),
C WHERE X AND Y ARE MULTIPLE-PRECISION NUMBERS AND
C IC IS AN INTEGER ARRAY OF DIMENSION AT LEAST N .GT. 0
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 3T+8
C (BUT Y(1) MAY BE R(2T+7))
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), IC(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, 8)
      I2 = 2*T + 7
      IF (N.GT.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (41H *** N NOT POSITIVE IN CALL TO MPPOLY ***)
      CALL MPERR
      Y(1) = 0
      RETURN
   20 CALL MPCIM (IC(N), R(I2))
      I = N - 1
      IF (I.LE.0) GO TO 40
   30 CALL MPMUL (R(I2), X, R(I2))
      CALL MPADDI (R(I2), IC(I), R(I2))
      I = I - 1
      IF (I.GT.0) GO TO 30
   40 CALL MPSTR (R(I2), Y)
      RETURN
      END
      SUBROUTINE MPPWR (X, N, Y)                                        MP044710
C RETURNS Y = X**N, FOR MP X AND Y, INTEGER N, WITH 0**0 = 1.
C R MUST BE DIMENSIONED AT LEAST 4T+10 IN CALLING PROGRAM
C (2T+6 IS ENOUGH IF N NONNEGATIVE).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1)
      I2 = T + 5
      N2 = N
      IF (N2) 20, 10, 40
C N = 0, RETURN Y = 1.
   10 CALL MPCIM (1, Y)
      RETURN
C N .LT. 0
   20 CALL MPCHK (4, 10)
      N2 = -N2
      IF (X(1).NE.0) GO TO 60
      WRITE (LUN, 30)
   30 FORMAT (47H *** ATTEMPT TO RAISE ZERO TO NEGATIVE POWER IN,
     $        29H CALL TO SUBROUTINE MPPWR ***)
      CALL MPERR
      GO TO 50
C N .GT. 0
   40 CALL MPCHK (2, 6)
      IF (X(1).NE.0) GO TO 60
C X = 0, N .GT. 0, SO Y = 0
   50 Y(1) = 0
      RETURN
C MOVE X
   60 CALL MPSTR (X, Y)
C IF N .LT. 0 FORM RECIPROCAL
      IF (N.LT.0) CALL MPREC (Y, Y)
      CALL MPSTR (Y, R(I2))
C SET PRODUCT TERM TO ONE
      CALL MPCIM (1, Y)
C MAIN LOOP, LOOK AT BITS OF N2 FROM RIGHT
   70 NS = N2
      N2 = N2/2
      IF ((2*N2).NE.NS) CALL MPMUL (Y, R(I2), Y)
      IF (N2.LE.0) RETURN
      CALL MPMUL (R(I2), R(I2), R(I2))
      GO TO 70
      END
      SUBROUTINE MPPWR2 (X, Y, Z)                                       MP045140
C RETURNS Z = X**Y FOR MP NUMBERS X, Y AND Z, WHERE X IS
C POSITIVE (X .EQ. 0 ALLOWED IF Y .GT. 0).  SLOWER THAN
C MPPWR AND MPQPWR, SO USE THEM IF POSSIBLE.
C DIMENSION OF R IN COMMON AT LEAST 7T+16
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), Z(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (7, 16)
      IF (X(1)) 10, 30, 70
   10 WRITE (LUN, 20)
   20 FORMAT (37H *** X NEGATIVE IN CALL TO MPPWR2 ***)
      GO TO 50
C HERE X IS ZERO, RETURN ZERO IF Y POSITIVE, OTHERWISE ERROR
   30 IF (Y(1).GT.0) GO TO 60
      WRITE (LUN, 40)
   40 FORMAT (51H *** X ZERO AND Y NONPOSITIVE IN CALL TO MPPWR2 ***)
   50 CALL MPERR
C RETURN ZERO HERE
   60 Z(1) = 0
      RETURN
C USUAL CASE HERE, X POSITIVE
C USE MPLN AND MPEXP TO COMPUTE POWER
   70 I2 = 6*T + 15
      CALL MPLN (X, R(I2))
      CALL MPMUL (Y, R(I2), Z)
C IF X**Y IS TOO LARGE, MPEXP WILL PRINT ERROR MESSAGE
      CALL MPEXP (Z, Z)
      RETURN
      END
      SUBROUTINE MPQPWR (I, J, K, L, X)                                 MP045450
C SETS MULTIPLE-PRECISION X = (I/J)**(K/L) FOR INTEGERS
C I, J, K AND L.  USES MPROOT IF ABS(L) SMALL, OTHERWISE
C USES MPLNI AND MPEXP.
C SPACE (DIMENSION OF R IN COMMON) = 4T+10
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
      IS = I
      JS = J
      KS = K
      LS = L
C FOR EFFICIENCY MAKE KS POSITIVE AND LS NEGATIVE
C (SEE COMMENTS IN MPROOT AND MPPWR).
      IF (KS) 40, 10, 50
C (I/J)**(0/L) = 1 IF J AND L ARE NONZERO.
   10 CALL MPCIM (1, X)
      IF ((JS.NE.0).AND.(LS.NE.0)) RETURN
   20 WRITE (LUN, 30)
   30 FORMAT (41H *** J = 0 OR L = 0 IN CALL TO MPQPWR ***)
      GO TO 90
   40 KS = -KS
      LS = -LS
C NOW KS IS POSITIVE, SO LOOK AT LS
   50 IF (LS) 70, 20, 60
C LS POSITIVE SO INTERCHANGE IS AND JS TO MAKE NEGATIVE
   60 IS = J
      JS = I
      LS = -LS
C NOW KS POSITIVE, LS NEGATIVE
   70 IF (IS.NE.0) GO TO 100
      WRITE (LUN, 80)
   80 FORMAT (30H *** I = 0 AND K/L NEGATIVE OR,
     $        45H J = 0 AND K/L POSITIVE IN CALL TO MPQPWR ***)
   90 CALL MPERR
      X(1) = 0
      RETURN
  100 X(1) = 0
C (I/0)**(NEGATIVE) = 0 IF I NONZERO
      IF (JS.EQ.0) RETURN
C TO SAVE TIME IN MPROOT AND MPPWR, FIND GCD OF KS AND LS
      CALL MPGCD (KS, LS)
C CHECK FOR LS = -1, TREAT AS SPECIAL CASE
      IF (LS.NE.(-1)) GO TO 110
      CALL MPCQM (JS, IS, X)
      GO TO 120
C USUAL CASE HERE, LS .NE. -1
  110 CALL MPCQM (IS, JS, X)
C USE MPROOT IF ABS(LS) .LE. MAX(B,64), OTHERWISE LOG AND EXP
      IF (IABS(LS).GT.MAX0(B, 64)) GO TO 130
      CALL MPROOT (X, LS, X)
  120 CALL MPPWR (X, KS, X)
      RETURN
C HERE USE LOG AND EXP (SLOWER THAN MPROOT)
  130 I2 = 3*T + 9
      CALL MPLNI (IABS(IS), R(I2))
      CALL MPLNI (IABS(JS), X)
C SOME CANCELLATION BUT NOT SERIOUS HERE
      CALL MPSUB (R(I2), X, X)
      CALL MPMULQ (X, KS, LS, X)
      CALL MPEXP (X, X)
C CORRECT SIGN IF NECESSARY
      IF (((IS.GE.0).AND.(JS.GE.0)).OR.
     $    ((IS.LT.0).AND.(JS.LT.0))) RETURN
C HERE IS/JS IS NEGATIVE
      X(1) = -X(1)
      IF (MOD(LS,2).NE.0) RETURN
      WRITE (LUN, 140)
  140 FORMAT (50H *** I/J NEGATIVE AND L EVEN IN CALL TO MPQPWR ***)
      GO TO 90
      END
      SUBROUTINE MPREC (X, Y)                                           MP046180
C RETURNS Y = 1/X, FOR MP X AND Y.
C MPROOT (X, -1, Y) HAS THE SAME EFFECT.
C DIMENSION OF R MUST BE AT LEAST 4*T+10 IN CALLING PROGRAM
C (BUT Y(1) MAY BE R(3T+9)).
C NEWTONS METHOD IS USED, SO FINAL ONE OR TWO DIGITS MAY
C NOT BE CORRECT.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2), EX, TS, TS2, TS3, IT(9)
      DATA IT(1), IT(2), IT(3), IT(4), IT(5) /0, 8, 6, 5, 4/
      DATA IT(6), IT(7), IT(8), IT(9) /4, 4, 4, 4/
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
C MPADDI REQUIRES 2T+6 WORDS.
      I2 = 2*T + 7
      I3 = I2 + T + 2
      IF (X(1).NE.0) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (51H *** ATTEMPTED DIVISION BY ZERO IN CALL TO MREC ***)
      CALL MPERR
      Y(1) = 0
      RETURN
   20 EX = X(2)
C TEMPORARILY INCREASE M TO AVOID OVERFLOW
      M = M + 2
C SET EXPONENT TO ZERO SO RX NOT TOO LARGE OR SMALL.
      X(2) = 0
      CALL MPCMR (X, RX)
C USE SINGLE-PRECISION RECIPROCAL AS FIRST APPROXIMATION
      CALL MPCRM (1E0/RX, R(I2))
C RESTORE EXPONENT
      X(2) = EX
C CORRECT EXPONENT OF FIRST APPROXIMATION
      R(I2+1) = R(I2+1) - EX
C SAVE T (NUMBER OF DIGITS)
      TS = T
C START WITH SMALL T TO SAVE TIME. ENSURE THAT B**(T-1) .GE. 100
      T = 3
      IF (B.LT.10) T = IT(B)
      IT0 = (T+4)/2
      IF (T.GT.TS) GO TO 70
C MAIN ITERATION LOOP
   30 CALL MPMUL (X, R(I2), R(I3))
      CALL MPADDI (R(I3), -1, R(I3))
C TEMPORARILY REDUCE T
      TS3 = T
      T = (T+IT0)/2
      CALL MPMUL (R(I2), R(I3), R(I3))
C RESTORE T
      T = TS3
      CALL MPSUB (R(I2), R(I3), R(I2))
      IF (T.GE.TS) GO TO 50
C FOLLOWING LOOP ALMOST DOUBLES T (POSSIBLE
C BECAUSE NEWTONS METHOD HAS 2ND ORDER CONVERGENCE).
      T = TS
   40 TS2 = T
      T = (T+IT0)/2
      IF (T.GT.TS3) GO TO 40
      T = MIN0 (TS, TS2)
      GO TO 30
C RETURN IF NEWTON ITERATION WAS CONVERGING
   50 IF ((R(I3).EQ.0).OR.((2*(R(I2+1)-R(I3+1))).GE.(T-IT0)))
     $    GO TO 70
      WRITE (LUN, 60)
C THE FOLLOWING MESSAGE MAY INDICATE THAT B**(T-1) IS TOO SMALL,
C OR THAT THE STARTING APPROXIMATION IS NOT ACCURATE ENOUGH.
   60 FORMAT (46H *** ERROR OCCURRED IN MPREC, NEWTON ITERATION,
     $        28H NOT CONVERGING PROPERLY ***)
      CALL MPERR
C MOVE RESULT TO Y AND RETURN AFTER RESTORING T
   70 T = TS
      CALL MPSTR (R(I2), Y)
C RESTORE M AND CHECK FOR OVERFLOW (UNDERFLOW IMPOSSIBLE)
      M = M - 2
      IF (Y(2).LE.M) RETURN
      WRITE (LUN, 80)
   80 FORMAT (35H *** OVERFLOW OCCURRED IN MPREC ***)
      CALL MPOVFL (Y)
      RETURN
      END
      SUBROUTINE MPROOT (X, N, Y)                                       MP046990
C RETURNS Y = X**(1/N) FOR INTEGER N, ABS(N) .LE. MAX (B, 64).
C AND MP NUMBERS X AND Y,
C USING NEWTONS METHOD WITHOUT DIVISIONS.   SPACE = 4T+10
C (BUT Y(1) MAY BE R(3T+9))
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1), EX, TS, TS2, TS3, XES, IT(9)
      DATA IT(1), IT(2), IT(3), IT(4), IT(5) /0, 8, 6, 5, 4/
      DATA IT(6), IT(7), IT(8), IT(9) /4, 4, 4, 4/
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
      IF (N.NE.1) GO TO 10
      CALL MPSTR (X, Y)
      RETURN
   10 I2 = 2*T + 7
      I3 = I2 + T + 2
      IF (N.NE.0) GO TO 30
      WRITE (LUN, 20)
   20 FORMAT (32H *** N = 0 IN CALL TO MPROOT ***)
      GO TO 50
   30 NP = IABS(N)
C LOSS OF ACCURACY IF NP LARGE, SO ONLY ALLOW NP .LE. MAX (B, 64)
      IF (NP.LE.MAX0 (B, 64)) GO TO 60
      WRITE (LUN, 40)
   40 FORMAT (43H *** ABS(N) TOO LARGE IN CALL TO MPROOT ***)
   50 CALL MPERR
      Y(1) = 0
      RETURN
C LOOK AT SIGN OF X
   60 IF (X(1)) 90, 70, 110
C X = 0 HERE, RETURN 0 IF N POSITIVE, ERROR IF NEGATIVE
   70 Y(1) = 0
      IF (N.GT.0) RETURN
      WRITE (LUN, 80)
   80 FORMAT (47H *** X = 0 AND N NEGATIVE IN CALL TO MPROOT ***)
      GO TO 50
C X NEGATIVE HERE, SO ERROR IF N IS EVEN
   90 IF (MOD(NP,2).NE.0) GO TO 110
      WRITE (LUN, 100)
  100 FORMAT (48H *** X NEGATIVE AND N EVEN IN CALL TO MPROOT ***)
      GO TO 50
C GET EXPONENT AND DIVIDE BY NP
  110 XES = X(2)
      EX = XES/NP
C REDUCE EXPONENT SO RX NOT TOO LARGE OR SMALL.
      X(2) = 0
      CALL MPCMR (X, RX)
C USE SINGLE-PRECISION ROOT FOR FIRST APPROXIMATION
      CALL MPCRM (EXP((FLOAT(NP*EX-XES)*ALOG(FLOAT(B))-ALOG(ABS(RX)))/
     $                 FLOAT(NP)), R(I2))
C SIGN OF APPROXIMATION SAME AS THAT OF X
      R(I2) = X(1)
C RESTORE EXPONENT
      X(2) = XES
C CORRECT EXPONENT OF FIRST APPROXIMATION
      R(I2+1) = R(I2+1) - EX
C SAVE T (NUMBER OF DIGITS)
      TS = T
C START WITH SMALL T TO SAVE TIME
      T = 3
C ENSURE THAT B**(T-1) .GE. 100
      IF (B.LT.10) T = IT(B)
      IF (T.GT.TS) GO TO 160
C IT0 IS A NECESSARY SAFETY FACTOR
      IT0 = (T+4)/2
C MAIN ITERATION LOOP
  120 CALL MPPWR (R(I2), NP, R(I3))
      CALL MPMUL (X, R(I3), R(I3))
      CALL MPADDI (R(I3), -1, R(I3))
C TEMPORARILY REDUCE T
      TS3 = T
      T = (T + IT0)/2
      CALL MPMUL (R(I2), R(I3), R(I3))
      CALL MPDIVI (R(I3), NP, R(I3))
C RESTORE T
      T = TS3
      CALL MPSUB (R(I2), R(I3), R(I2))
C FOLLOWING LOOP ALMOST DOUBLES T (POSSIBLE BECAUSE
C NEWTONS METHOD HAS 2ND ORDER CONVERGENCE).
      IF (T.GE.TS) GO TO 140
      T = TS
  130 TS2 = T
      T = (T + IT0)/2
      IF (T.GT.TS3) GO TO 130
      T = MIN0 (TS, TS2)
      GO TO 120
C NOW R(I2) IS X**(-1/NP)
C CHECK THAT NEWTON ITERATION WAS CONVERGING
  140 IF ((R(I3).EQ.0).OR.((2*(R(I2+1)-R(I3+1))).GE.(T-IT0)))
     $   GO TO 160
      WRITE (LUN, 150)
C THE FOLLOWING MESSAGE MAY INDICATE THAT B**(T-1) IS TOO SMALL,
C OR THAT THE INITIAL APPROXIMATION OBTAINED USING ALOG AND EXP
C IS NOT ACCURATE ENOUGH.
  150 FORMAT (47H *** ERROR OCCURRED IN MPROOT, NEWTON ITERATION,
     $        28H NOT CONVERGING PROPERLY ***)
      CALL MPERR
C RESTORE T
  160 T = TS
      IF (N.LT.0) GO TO 170
      CALL MPPWR (R(I2), N-1, R(I2))
      CALL MPMUL (X, R(I2), Y)
      RETURN
  170 CALL MPSTR (R(I2), Y)
      RETURN
      END
      SUBROUTINE MPSET (LUNIT, IDECPL, ITMAX2, MAXDR)                   MP048046
C SETS BASE (B) AND NUMBER OF DIGITS (T) TO GIVE THE
C EQUIVALENT OF AT LEAST IDECPL DECIMAL DIGITS.
C IDECPL SHOULD BE POSITIVE.
C ITMAX2 IS THE DIMENSION OF ARRAYS USED FOR MP NUMBERS,
C SO AN ERROR OCCURS IF THE COMPUTED T EXCEEDS ITMAX2 - 2.
C MPSET ALSO SETS
C       LUN = LUNIT (LOGICAL UNIT FOR ERROR MESSAGES),
C       MXR = MAXDR (DIMENSION OF R IN COMMON, .GE. T+4), AND
C         M = (W-1)/4 (MAXIMUM ALLOWABLE EXPONENT),
C WHERE W IS THE LARGEST INTEGER OF THE FORM 2**K-1 WHICH IS
C REPRESENTABLE IN THE MACHINE, K .LE. 47
C THE COMPUTED B AND T SATISFY THE CONDITIONS
C (T-1)*LN(B)/LN(10) .GE. IDECPL   AND   8*B*B-1 .LE. W .
C APPROXIMATELY MINIMAL T AND MAXIMAL B SATISFYING
C THESE CONDITIONS ARE CHOSEN.
C PARAMETERS LUNIT, IDECPL, ITMAX2 AND MAXDR ARE INTEGERS.
C BEWARE - MPSET WILL CAUSE AN INTEGER OVERFLOW TO OCCUR
C ******   IF WORDLENGTH IS LESS THAN 48 BITS.
C          IF THIS IS NOT ALLOWABLE, CHANGE THE DETERMINATION
C          OF W (DO 30 ... TO 30 W = WN) OR SET B, T, M,
C          LUN AND MXR WITHOUT CALLING MPSET.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), W, WN, W2
C FIRST SET LUN AND MXR
      LUN = LUNIT
      MXR = MAXDR
C CHECK THAT LUN IN RANGE 1,...,99 AND WRITE ERROR MESSAGE
C ON UNIT 6 IF NOT.
      IF ((LUN.GT.0).AND.(LUN.LT.100)) GO TO 20
      WRITE (6, 10) LUN
   10 FORMAT (12H *** LUNIT =, I10, 29H ILLEGAL IN CALL TO MPSET ***)
      LUN = 6
      CALL MPERR
      RETURN
C DETERMINE LARGE REPRESENTABLE INTEGER W OF FORM 2**K - 1
   20 W = 0
      K = 0
C ON CYBER 76 HAVE TO FIND K .LE. 47, SO ONLY LOOP
C 47 TIMES AT MOST.  IF GENUINE INTEGER WORDLENGTH
C EXCEEDS 47 BITS THIS RESTRICTION CAN BE RELAXED.
      DO 30 I = 1, 47
C INTEGER OVERFLOW WILL EVENTUALLY OCCUR HERE
C IF WORDLENGTH .LT. 48 BITS
      W2 = W + W
      WN = W2 + 1
C APPARENTLY REDUNDANT TESTS MAY BE NECESSARY ON SOME
C MACHINES, DEPENDING ON HOW INTEGER OVERFLOW IS HANDLED
      IF ((WN.LE.W).OR.(WN.LE.W2).OR.(WN.LE.0)) GO TO 40
      K = I
   30 W = WN
C SET MAXIMUM EXPONENT TO (W-1)/4
   40 M = W/4
      IF (IDECPL.GT.0) GO TO 60
      WRITE (LUN, 50)
   50 FORMAT (39H *** IDECPL .LE. 0 IN CALL TO MPSET ***)
      CALL MPERR
      RETURN
C B IS THE LARGEST POWER OF 2 SUCH THAT (8*B*B-1) .LE. W
   60 B = 2**((K-3)/2)
C 2E0 BELOW ENSURES AT LEAST ONE GUARD DIGIT
      T = INT(2E0 + FLOAT(IDECPL)*ALOG(10E0)/ALOG(FLOAT(B)))
C SEE IF T TOO LARGE FOR DIMENSION STATEMENTS
      I2 = T + 2
      IF (I2.LE.ITMAX2) GO TO 80
      WRITE (LUN, 70) I2
   70 FORMAT (42H *** ITMAX2 TOO SMALL IN CALL TO MPSET *** /
     $  48H *** INCREASE ITMAX2 AND DIMENSIONS OF MP ARRAYS,
     $  12H TO AT LEAST, I10, 4H ***)
      CALL MPERR
C REDUCE TO MAXIMUM ALLOWED BY DIMENSION STATEMENTS
      T = ITMAX2 - 2
C CHECK LEGALITY OF B, T, M, LUN AND MXR (AT LEAST T+4)
   80 CALL MPCHK (1, 4)
      RETURN
      END
      FUNCTION MPSIGA (X)                                               MP048743
C RETURNS SIGN OF MP NUMBER X
      INTEGER X(1)
      MPSIGA = X(1)
      RETURN
      END
      SUBROUTINE MPSIGB (I, X)                                          MP048763
C SETS SIGN OF MP NUMBER X TO I.
C I SHOULD BE 0, +1 OR -1.
C EXPONENT AND DIGITS OF X ARE UNCHANGED,
C BUT RESULT MUST BE A VALID MP NUMBER.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3)
      X(1) = I
C CHECK FOR VALID SIGN
      IF (IABS(I).LE.1) GO TO 20
      WRITE (LUN, 10)
   10 FORMAT (39H *** INVALID SIGN IN CALL TO MPSIGB ***)
      GO TO 40
C RETURN IF X ZERO
   20 IF (I.EQ.0) RETURN
C CHECK FOR VALID EXPONENT AND LEADING DIGIT
      IF ((IABS(X(2)).LE.M).AND.(X(3).GT.0).AND.(X(3).LT.B)) RETURN
      WRITE (LUN, 30)
   30 FORMAT (48H *** X NOT VALID MP NUMBER IN CALL TO MPSIGB ***)
   40 CALL MPERR
      X(1) = 0
      RETURN
      END
      SUBROUTINE MPSIN (X, Y)                                           MP048820
C RETURNS Y = SIN(X) FOR MP X AND Y,
C METHOD IS TO REDUCE X TO (-1, 1) AND USE MPSIN1, SO
C TIME IS O(M(T)T/LOG(T)).
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(1), XS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (5, 12)
      I2 = 4*T + 11
      IF (X(1).NE.0) GO TO 20
   10 Y(1) = 0
      RETURN
   20 XS = X(1)
      IE = IABS(X(2))
      IF (IE.LE.2) CALL MPCMR (X, RX)
      CALL MPABS (X, R(I2))
C USE MPSIN1 IF ABS(X) .LE. 1
      IF (MPCMPI (R(I2), 1) .GT. 0) GO TO 30
      CALL MPSIN1 (R(I2), Y, 1)
      GO TO 50
C FIND ABS(X) MODULO 2PI (IT WOULD SAVE TIME IF PI WERE
C PRECOMPUTED AND SAVED IN COMMON).
C FOR INCREASED ACCURACY COMPUTE PI/4 USING MPART1
   30 I3 = 2*T + 7
      CALL MPART1 (5, R(I3))
      CALL MPMULI (R(I3), 4, R(I3))
      CALL MPART1 (239, Y)
      CALL MPSUB (R(I3), Y, Y)
      CALL MPDIV (R(I2), Y, R(I2))
      CALL MPDIVI (R(I2), 8, R(I2))
      CALL MPCMF (R(I2), R(I2))
C SUBTRACT 1/2, SAVE SIGN AND TAKE ABS
      CALL MPADDQ (R(I2), -1, 2, R(I2))
      XS = -XS*R(I2)
      IF (XS.EQ.0) GO TO 10
      R(I2) = 1
      CALL MPMULI (R(I2), 4, R(I2))
C IF NOT LESS THAN 1, SUBTRACT FROM 2
      IF (R(I2+1).GT.0) CALL MPADDI (R(I2), -2, R(I2))
      IF (R(I2).EQ.0) GO TO 10
      R(I2) = 1
      CALL MPMULI (R(I2), 2, R(I2))
C NOW REDUCED TO FIRST QUADRANT, IF LESS THAN PI/4 USE
C POWER SERIES, ELSE COMPUTE COS OF COMPLEMENT
      IF (R(I2+1).GT.0) GO TO 40
      CALL MPMUL (R(I2), Y, R(I2))
      CALL MPSIN1 (R(I2), Y, 1)
      GO TO 50
   40 CALL MPADDI (R(I2), -2, R(I2))
      CALL MPMUL (R(I2), Y, R(I2))
      CALL MPSIN1 (R(I2), Y, 0)
   50 Y(1) = XS
      IF (IE.GT.2) RETURN
C CHECK THAT ABSOLUTE ERROR LESS THAN 0.01 IF ABS(X) .LE. 100
C (IF ABS(X) IS LARGE THEN SINGLE-PRECISION SIN INACCURATE)
      IF (ABS(RX) .GT. 100.0) RETURN
      CALL MPCMR (Y, RY)
      IF (ABS(RY - SIN(RX)) .LT. 0.01) RETURN
      WRITE (LUN, 60)
C THE FOLLOWING MESSAGE MAY INDICATE THAT
C B**(T-1) IS TOO SMALL.
   60 FORMAT (50H *** ERROR OCCURRED IN MPSIN, RESULT INCORRECT ***)
      CALL MPERR
      RETURN
      END
      SUBROUTINE MPSINH (X, Y)                                          MP049490
C RETURNS Y = SINH(X) FOR MP NUMBERS X AND Y, X NOT TOO LARGE.
C METHOD IS TO USE MPEXP OR MPEXP1, SPACE = 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), XS
C SAVE SIGN OF X AND CHECK FOR ZERO, SINH(0) = 0
      XS = X(1)
      IF (XS.NE.0) GO TO 10
      Y(1) = 0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 12)
      I3 = 4*T + 11
C WORK WITH ABS(X)
      CALL MPABS (X, R(I3))
      IF (R(I3+1).LE.0) GO TO 20
C HERE ABS(X) .GE. 1, IF TOO LARGE MPEXP GIVES ERROR MESSAGE
C INCREASE M TO AVOID OVERFLOW IF SINH(X) REPRESENTABLE
      M = M + 2
      CALL MPEXP (R(I3), R(I3))
      CALL MPREC (R(I3), Y)
      CALL MPSUB (R(I3), Y, Y)
C RESTORE M.  IF RESULT OVERFLOWS OR UNDERFLOWS, MPDIVI AT
C STATEMENT 30 WILL ACT ACCORDINGLY.
      M = M - 2
      GO TO 30
C HERE ABS(X) .LT. 1 SO USE MPEXP1 TO AVOID CANCELLATION
   20 I2 = I3 - (T+2)
      CALL MPEXP1 (R(I3), R(I2))
      CALL MPADDI (R(I2), 2, R(I3))
      CALL MPMUL (R(I3), R(I2), Y)
      CALL MPADDI (R(I2), 1, R(I3))
      CALL MPDIV (Y, R(I3), Y)
C DIVIDE BY TWO AND RESTORE SIGN
   30 CALL MPDIVI (Y, 2*XS, Y)
      RETURN
      END
      SUBROUTINE MPSIN1 (X, Y, IS)                                      MP049870
C COMPUTES Y = SIN(X) IF IS.NE.0, Y = COS(X) IF IS.EQ.0,
C USING TAYLOR SERIES.   ASSUMES ABS(X) .LE. 1.
C X AND Y ARE MP NUMBERS, IS AN INTEGER.
C TIME IS O(M(T)T/LOG(T)).   THIS COULD BE REDUCED TO
C O(SQRT(T)M(T)) AS IN MPEXP1, BUT NOT WORTHWHILE UNLESS
C T IS VERY LARGE.  ASYMPTOTICALLY FASTER METHODS ARE
C DESCRIBED IN THE REFERENCES GIVEN IN COMMENTS
C TO MPATAN AND MPPIGL.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 3T+8
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, B2, T, R(1), X(1), Y(1), TS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, 8)
      IF (X(1).NE.0) GO TO 20
C SIN(0) = 0, COS(0) = 1
   10 Y(1) = 0
      IF (IS.EQ.0) CALL MPCIM (1, Y)
      RETURN
   20 I2 = T + 5
      I3 = I2 + T + 2
      B2 = 2*MAX0(B, 64)
      CALL MPMUL (X, X, R(I3))
      IF (MPCMPI (R(I3), 1) .LE. 0) GO TO 40
      WRITE (LUN, 30)
   30 FORMAT (40H *** ABS(X) .GT. 1 IN CALL TO MPSIN1 ***)
      CALL MPERR
      GO TO 10
   40 IF (IS.EQ.0) CALL MPCIM (1, R(I2))
      IF (IS.NE.0) CALL MPSTR (X, R(I2))
      Y(1) = 0
      I = 1
      TS = T
      IF (IS.EQ.0) GO TO 50
      CALL MPSTR (R(I2), Y)
      I = 2
C POWER SERIES LOOP.  REDUCE T IF POSSIBLE
   50 T = R(I2+1) + TS + 2
      IF (T.LE.2) GO TO 80
      T = MIN0 (T, TS)
C PUT R(I3) FIRST IN CASE ITS DIGITS ARE MAINLY ZERO
      CALL MPMUL (R(I3), R(I2), R(I2))
C IF I*(I+1) IS NOT REPRESENTABLE AS AN INTEGER, THE FOLLOWING
C DIVISION BY I*(I+1) HAS TO BE SPLIT UP.
      IF (I.GT.B2) GO TO 60
      CALL MPDIVI (R(I2), -I*(I+1), R(I2))
      GO TO 70
   60 CALL MPDIVI (R(I2), -I, R(I2))
      CALL MPDIVI (R(I2), I+1, R(I2))
   70 I = I + 2
      T = TS
      CALL MPADD2 (R(I2), Y, Y, Y, 0)
      IF (R(I2).NE.0) GO TO 50
   80 T = TS
      IF (IS.EQ.0) CALL MPADDI (Y, 1, Y)
      RETURN
      END
      SUBROUTINE MPSQRT (X, Y)                                          MP050450
C RETURNS Y = SQRT(X), USING SUBROUTINE MPROOT IF X .GT. 0.
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 4T+10
C (BUT Y(1) MAY BE R(3T+9)).  X AND Y ARE MP NUMBERS.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(3)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (4, 10)
C MPROOT NEEDS 4T+10 WORDS, BUT CAN OVERLAP SLIGHTLY.
      I2 = 3*T + 9
      IF (X(1)) 10, 30, 40
   10 WRITE (LUN, 20)
   20 FORMAT (48H *** X NEGATIVE IN CALL TO SUBROUTINE MPSQRT ***)
      CALL MPERR
   30 Y(1) = 0
      RETURN
   40 CALL MPROOT (X, -2, R(I2))
      I = R(I2+2)
      CALL MPMUL (X, R(I2), Y)
      IY3 = Y(3)
      CALL MPEXT (I, IY3, Y)
      RETURN
      END
      SUBROUTINE MPSTR (X, Y)                                           MP050690
C SETS Y = X FOR MP X AND Y.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), T2
C SEE IF X AND Y HAVE THE SAME ADDRESS (THEY OFTEN DO)
      J = X(1)
      Y(1) = J + 1
      IF (J.EQ.X(1)) GO TO 10
C HERE X(1) AND Y(1) MUST HAVE THE SAME ADDRESS
      X(1) = J
      RETURN
C HERE X(1) AND Y(1) HAVE DIFFERENT ADDRESSES
   10 Y(1) = J
C NO NEED TO MOVE X(2), ... IF X(1) = 0
      IF (J.EQ.0) RETURN
      T2 = T + 2
      DO 20 I = 2, T2
   20 Y(I) = X(I)
      RETURN
      END
      SUBROUTINE MPSUB (X, Y, Z)                                        MP050900
C SUBTRACTS Y FROM X, FORMING RESULT IN Z, FOR MP X, Y AND Z.
C FOUR GUARD DIGITS ARE USED, AND THEN R*-ROUNDING
      INTEGER X(1), Y(1), Z(1), Y1(1)
      Y1(1) = -Y(1)
      CALL MPADD2 (X, Y, Z, Y1, 0)
      RETURN
      END
      SUBROUTINE MPTAN (X, Y)                                           MP050990
C SETS Y = TAN(X) FOR MP X AND Y
C USES SUBROUTINE MPSIN1 SO TIME IS O(M(T)T/LOG(T)).
C DIMENSION OF R IN CALLING PROGRAM MUST BE AT LEAST 6T+20
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), FL, TS, XS
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (6, 20)
      TS = T
      I2 = 4*T + 15
      I3 = I2 + T + 3
      IF (X(1).NE.0) GO TO 20
   10 Y(1) = 0
      T = TS
      RETURN
C SAVE SIGN AND WORK WITH ABS(X)
   20 XS = X(1)
      CALL MPCLR (R(I2), T+1)
      CALL MPABS (X, R(I2))
C USE ONE GUARD DIGIT THROUGHOUT
      T = T + 1
      CALL MPPI (R(I3))
C COMPUTE ABS(X) MODULO PI
      CALL MPDIV (R(I2), R(I3), R(I2))
      CALL MPDIVI (R(I3), 4, R(I3))
      CALL MPCMF (R(I2), R(I2))
      CALL MPMULI (R(I2), 2, R(I2))
      IF (R(I2).EQ.0) GO TO 10
C NOW IN (0, 2), MAKE IT (-1, 1)
      IF (R(I2+1).GT.0) CALL MPADDI (R(I2), -2, R(I2))
      CALL MPMULI (R(I2), 2, R(I2))
      IF (R(I2).EQ.0) GO TO 10
      XS = XS*R(I2)
      R(I2) = 1
C METHODS DEPEND ON WHETHER ABS(TAN(X)) .LT. 1 OR NOT
      FL = R(I2+1)
      IF (FL.LE.0) GO TO 30
      R(I2) = -1
      CALL MPADDI (R(I2), 2, R(I2))
   30 CALL MPMUL (R(I2), R(I3), R(I2))
      CALL MPSIN1 (R(I2), R(I2), 1)
      CALL MPMUL (R(I2), R(I2), R(I3))
      R(I3) = -R(I3)
      CALL MPADDI (R(I3), 1, R(I3))
      CALL MPROOT (R(I3), -2, R(I3))
      CALL MPMUL (R(I3), R(I2), R(I3))
      IF (FL.LE.0) GO TO 60
      IF (R(I3).NE.0) GO TO 50
      T = TS
C HERE X IS TOO CLOSE TO AN ODD MULTIPLE OF PI/2
C TREAT AS OVERFLOW THOUGH NOT QUITE THE SAME
      WRITE (LUN, 40)
   40 FORMAT (42H *** TAN(X) TOO LARGE IN CALL TO MPTAN ***)
      CALL MPOVFL (Y)
      RETURN
   50 CALL MPREC (R(I3), R(I3))
C RESTORE T AND MOVE RESULT NOW
   60 T = TS
      CALL MPSTR (R(I3), Y)
      Y(1) = XS*Y(1)
      RETURN
      END
      SUBROUTINE MPTANH (X, Y)                                          MP051620
C RETURNS Y = TANH(X) FOR MP NUMBERS X AND Y,
C USING MPEXP OR MPEXP1, SPACE = 5T+12
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1), Y(1), XS
      IF (X(1).NE.0) GO TO 10
C TANH(0) = 0
      Y(1) = 0
      RETURN
C CHECK LEGALITY OF B, T, M, LUN AND MXR
   10 CALL MPCHK (5, 12)
      I2 = 4*T + 11
C SAVE SIGN AND WORK WITH ABS(X)
      XS = X(1)
      CALL MPABS (X, R(I2))
C SEE IF ABS(X) SO LARGE THAT RESULT IS +-1
      CALL MPCRM (0.5E0*FLOAT(T)*ALOG(FLOAT(B)), Y)
      IF (MPCOMP (R(I2), Y) .LE. 0) GO TO 20
C HERE ABS(X) IS VERY LARGE
      CALL MPCIM (XS, Y)
      RETURN
C HERE ABS(X) NOT SO LARGE
   20 CALL MPMULI (R(I2), 2, R(I2))
      IF (R(I2+1).LE.0) GO TO 30
C HERE ABS(X) .GE. 1/2 SO USE MPEXP
      CALL MPEXP (R(I2), R(I2))
      CALL MPADDI (R(I2), -1, Y)
      CALL MPADDI (R(I2), 1, R(I2))
      CALL MPDIV (Y, R(I2), Y)
      GO TO 40
C HERE ABS(X) .LT. 1/2, SO USE MPEXP1 TO AVOID CANCELLATION
   30 CALL MPEXP1 (R(I2), R(I2))
      CALL MPADDI (R(I2), 2, Y)
      CALL MPDIV (R(I2), Y, Y)
C RESTORE SIGN
   40 Y(1) = XS*Y(1)
      RETURN
      END
      SUBROUTINE MPUNFL (X)                                             MP052010
C CALLED ON MULTIPLE-PRECISION UNDERFLOW, IE WHEN THE
C EXPONENT OF MP NUMBER X WOULD BE LESS THAN -M.
      INTEGER X(1)
C SINCE M MAY HAVE BEEN OVERWRITTEN, CHECK B, T, M ETC.
      CALL MPCHK (1, 4)
C THE UNDERFLOWING NUMBER IS SET TO ZERO
C AN ALTERNATIVE WOULD BE TO CALL MPMINR (X) AND RETURN,
C POSSIBLY UPDATING A COUNTER AND TERMINATING EXECUTION
C AFTER A PRESET NUMBER OF UNDERFLOWS.  ACTION COULD EASILY
C BE DETERMINED BY A FLAG IN LABELLED COMMON.
      X(1) = 0
      RETURN
      END
      SUBROUTINE MPUNPK (Y, X)                                          MP052156
C RESTORES THE MP NUMBER X WHICH IS STORED IN COMPRESSED
C FORMAT IN THE INTEGER ARRAY Y.  FOR FURTHER DETAILS SEE
C SUBROUTINE MPPACK.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(2), Y(2)
C CHECK FOR ZERO
      IF (Y(2).NE.0) GO TO 10
      X(1) = 0
      RETURN
C HERE Y IS NONZERO. GET SIGN THEN UNPACK DIGITS.
   10 IS = 1
      IF (Y(2).LT.0) IS = -1
      J = T/2
C DO LAST DIGIT SEPARATELY IF T ODD.
      IF ((2*J).LT.T) X(T+2) = Y(J+2)/B
C WORK BACKWARDS IN CASE X AND Y ARE THE SAME ARRAY.
      DO 20 IB = 1, J
      I = J - IB
      K = IABS(Y(I+2))
      K1 = K/B
      X(2*I+3) = K1
   20 X(2*I+4) = K - B*K1
C FINALLY MOVE EXPONENT AND SIGN TO X.
      X(2) = Y(1)
      X(1) = IS
      RETURN
      END
      SUBROUTINE MPUPK (SOURCE, DEST, LDEST, LFIELD)                    MP052343
C
C              *************************    (SEE SECTION 5 OF
C              *** MACHINE DEPENDENT ***     USERS GUIDE FOR
C              *************************     CONVERSION HINTS)
C
C MACHINE-DEPENDENT STATEMENTS ARE SURROUNDED BY C *** LINES
C ***
C THIS IS UNIVAC 1100, FORTRAN V VERSION.
C ***
C THIS SUBROUTINE UNPACKS A PACKED HOLLERITH STRING (SOURCE)
C PLACING ONE CHARACTER PER WORD IN THE ARRAY DEST (AS IF READ IN
C A1 FORMAT). IT CONTINUES UNPACKING UNTIL IT FINDS A SENTINEL ($)
C OR UNTIL IT FINDS A COMPILER GENERATED SENTINEL (IF SO
C IMPLEMENTED) OR UNTIL IT HAS FILLED LDEST WORDS OF THE
C ARRAY DEST.  THE LENGTH OF THE UNPACKED STRING IS RETURNED
C IN LFIELD.   THUS 0 .LE. LFIELD .LE. LDEST.
      INTEGER SOURCE(1), DEST(1), BLANKS, TEMP
      DATA BLANKS /1H /, IST /1H$/
C NK IS THE NUMBER OF CHARACTERS PER WORD
C AND ISTC IS THE COMPILER-GENERATED SENTINEL (IF ANY)
C ***
      DATA NK /6/, ISTC /0/
C ***
      TEMP = BLANKS
      LD = LDEST
      LFIELD = 0
      IF (LD.LE.0) RETURN
      DO 10 K = 1, LD
      I = LFIELD/NK + 1
C GET NEXT WORD (CONTAINING NK CHARACTERS) AND
C CHECK FOR COMPILER-GENERATED END-OF-STRING SENTINEL
      IF (SOURCE(I) .EQ. ISTC) RETURN
C MOVE (MOD(LFIELD,NK)+1)-TH CHARACTER OF SOURCE(I) TO
C FIRST (I.E. LEFTMOST) CHARACTER POSITION OF TEMP
C ***
      FLD (0, 6, TEMP) = FLD (6*MOD(LFIELD,6), 6, SOURCE(I))
C ***
C CHECK FOR END-OF-STRING SENTINEL
      IF (TEMP .EQ. IST)  RETURN
      LFIELD = K
   10 DEST(K) = TEMP
      RETURN
      END
      SUBROUTINE MPZETA (N, X)                                          MP052450
C RETURNS MP X = ZETA(N) FOR INTEGER N .GT. 1, WHERE
C ZETA(N) IS THE RIEMANN ZETA FUNCTION (THE SUM FROM
C I = 1 TO INFINITY OF I**(-N)).
C USES THE EULER-MACLAURIN SERIES UNLESS N = 2, 4, 6 OR 8.
C IN WORST CASE SPACE IS 8T+18+NL*((T+3)/2),
C WHERE NL IS THE NUMBER OF TERMS USED IN THE EULER-
C MACLAURIN SERIES, NL .LE. 1 + AL*T*LN(B), WHERE
C AL IS GIVEN IN A DATA STATEMENT BELOW.
C TIME IS O(T**3).
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(3), ID(4), P, TS
C AL AND AL2 ARE EMPIRICALLY DETERMINED CONSTANTS, CHOSEN TO
C APPROXIMATELY MINIMIZE EXECUTION TIME.  IF SPACE IS CRITICAL,
C AL MAY BE REDUCED.
      DATA AL /0.1E0/, AL2 /5.0E0/
C ZETA(N) KNOWN IN TERMS OF BERNOULLI NUMBERS AND
C PI**N IF N IS EVEN.  ID DEFINES ZETA(2), ... , ZETA(8).
      DATA ID(1), ID(2), ID(3), ID(4) /6, 90, 945, 9450/
C CHECK B, T ETC AND ENSURE ENOUGH SPACE FOR MPPI
      CALL MPCHK (3, 8)
      X(1) = 0
      IF (N.GT.1) GO TO 20
      WRITE (LUN, 10) N
   10 FORMAT (8H *** N =, I10, 29H .LE. 1 IN CALL TO MPZETA ***)
      GO TO 130
C HERE N .GT. 1.  SEE IF N = 2, 4, 6 OR 8.
   20 IF ((N.GT.8).OR.(MOD(N,2).NE.0)) GO TO 30
C HERE ZETA(N) = (PI**N)/ID(N/2)
      CALL MPPI (X)
      CALL MPPWR (X, N, X)
      N2 = N/2
      CALL MPDIVI (X, ID(N2), X)
      GO TO 110
C SEE IF N IS VERY LARGE.  CAN RETURN WITH ZETA(N) = 1 TO
C REQUIRED PRECISION IF 2**N .GE. 2*B**(T-1)
   30 ALBT = ALOG(FLOAT(B))*FLOAT(T-1) + ALOG(2E0)
      FN = FLOAT(N)
      IF ((FN*ALOG(2E0)).GE.ALBT) GO TO 100
C HERE WE MAY USE EULER-MACLAURIN SERIES. FOR N = 3
C THE SERIES OF GOSPER (AS USED IN PROGRAM TEST) IS FASTER.
C SERIES FOR OTHER ODD N ARE GIVEN BY H. RIESEL IN
C BIT 13 (1973), 97-113.
C ESTIMATE NUMBER OF TERMS IN ASYMPTOTIC EXPANSION
      NL = 1 + INT(AL*ALBT)
C ESTIMATE NUMBER OF TERMS REQUIRED IN FINITE SUM.
C CONSTANTS ARE 2(1+LN(2*PI)) = 5.675 AND 1+LN(2*PI**2) = 3.982
      FNL = FLOAT(NL)
      NM = 2 + INT (EXP ((ALBT + (FN+2E0*FNL+0.5E0)*
     $     ALOG(FN+2E0*FNL) - ((FN-0.5E0)*ALOG(FN-1E0)
     $     + 5.675E0*FNL + 3.982E0))/(FN+2E0*FNL+1E0)))
      P = (T+3)/2
      I2 = 6*T + 15
      I3 = I2 + T + 2
      I4 = I3 + T + 2
C SEE IF IT WOULD BE BETTER NOT TO USE ASYMPTOTIC EXPANSION
      IF (((FN-1E0)*ALOG(AL2*FNL+FLOAT(NM))).LT.ALBT) GO TO 40
C DONT USE ASYMPTOTIC EXPANSION, BUT RECOMPUTE NM
      NM = 2 + INT(EXP(ALBT/(FN-1E0)))
      GO TO 70
C CHECK THAT SPACE IS SUFFICIENT
   40 CALL MPCHK (8, NL*P+18)
C COMPUTE REQUIRED BERNOULLI NUMBERS (IF ZETA(N) IS REQUIRED
C FOR SEVERAL N, IT WOULD SAVE TIME TO PRECOMPUTE THESE).
      CALL MPBERN (NL, P, R(I4))
      CALL MPCQM (N, 2*NM, R(I2))
      CALL MPDIVI (R(I2), NM, R(I2))
C SUM EULER-MACLAURIN ASYMPTOTIC SERIES FIRST
      DO 50 I = 1, NL
      IP = I4 + (I-1)*P
      CALL MPUNPK (R(IP), R(I3))
      CALL MPMUL (R(I2), R(I3), R(I3))
      CALL MPADD (X, R(I3), X)
      CALL MPMULQ (R(I2), N+2*I-1, 2*I+1, R(I2))
      CALL MPMULQ (R(I2), N+2*I, 2*I+2, R(I2))
      CALL MPDIVI (R(I2), NM, R(I2))
   50 CALL MPDIVI (R(I2), NM, R(I2))
C ADD INTEGRAL APPROXIMATION AND MULTIPLY BY NM**(1-N)
      CALL MPADDQ (X, 1, N-1, X)
      DO 60 I = 2, N
   60 CALL MPDIVI (X, NM, X)
C ADD FINITE SUM IN FORWARD DIRECTION SO CAN REDUCE T
C MORE EASILY THAN IF BACKWARD DIRECTION WERE USED.
   70 R(I2+1) = 0
      TS = T
      IQ = 1
      DO 90 I = 2, NM
C REDUCE T FOR I**(-N) COMPUTATION IF POSSIBLE
      T = MAX0 (2, TS + R(I2+1))
      IB = MAX0(7*B*B, 32767)/I
      CALL MPCIM (1, R(I2))
C DO SINGLE-PRECISION OPERATIONS WHERE POSSIBLE,
C MULTIPLE-PRECISION ONLY WHERE NECESSARY.
      DO 80 J = 1, N
      IQ = I*IQ
      IF ((IQ.LE.IB).AND.(IQ.NE.B).AND.(J.LT.N)) GO TO 80
      CALL MPDIVI (R(I2), IQ, R(I2))
      IQ = 1
   80 CONTINUE
C NOW R(I2) IS I**(-N).  HALVE LAST TERM IN FINITE SUM.
      IF (I.EQ.NM) CALL MPDIVI (R(I2), 2, R(I2))
C RESTORE T FOR ADDITION
      T = TS
C LEAVE FINITE SUM LOOP IF MP UNDERFLOW OCCURRED
      IF (R(I2).EQ.0) GO TO 100
   90 CALL MPADD2 (R(I2), X, X, X, 0)
  100 CALL MPADDI (X, 1, X)
C CHECK THAT 1 .LE. ZETA(N) .LT. 2
  110 IF ((X(1).EQ.1).AND.(X(2).EQ.1).AND.(X(3).EQ.1)) RETURN
      WRITE (LUN, 120)
  120 FORMAT (51H *** ERROR OCCURRED IN MPZETA, RESULT INCORRECT ***)
  130 CALL MPERR
      RETURN
      END
      SUBROUTINE MP40D (N, X)                                           MP053600
C PRINTING ROUTINE CALLED BY TEST PROGRAM, PRINTS MP X TO
C N DECIMAL PLACES, ASSUMING -10 .LT. X .LT. 100.
C SPACE = 3T + N + 14.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (3, N+14)
C DO NOTHING IF N NONPOSITIVE
      IF (N.LE.0) RETURN
      I2 = 3*T + 12
C CONVERT TO CHARACTER FORMAT AND CALL MP40E TO PRINT
      CALL MPOUT (X, R(I2), N+3, N)
      CALL MP40E (N+3, R(I2))
      RETURN
      END
      SUBROUTINE MP40E (N, X)                                           MP053770
C WRITES X(1), ... , X(N) ON UNIT LUN, WHERE X IS AN
C INTEGER ARRAY OF DIMENSION AT LEAST N.  CALLED BY MP40D.
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(N)
C FOLLOWING IS USUALLY FASTER THAN USING AN IMPLIED DO LOOP
C BUT DOES NOT WORK WITH RALPH COMPILER ON UNIVAC 1100
C COMPUTERS, WHEN IT SHOULD BE REPLACED BY IMPLIED DO LOOP.
      WRITE (LUN, 10) X
   10 FORMAT (8X, 13A1, 4(1X, 10A1) /
     $ (11X, 10A1, 1X, 10A1, 1X, 10A1, 1X, 10A1, 1X, 10A1))
      RETURN
      END
      SUBROUTINE MP40F (N, X)                                           MP053910
C PRINTING ROUTINE CALLED BY TEST2 PROGRAM, PRINTS X TO
C N SIGNIFICANT FIGURES, N .GE. 2.
C DIM OF R IN COMMON AT LEAST 6T+N+17
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(1)
C CHECK LEGALITY OF B, T, M, LUN AND MXR
      CALL MPCHK (6, N+17)
C DO NOTHING IF N.LT.2
      IF (N.LT.2) RETURN
      I2 = 6*T + 15
C CONVERT TO PRINTABLE FORM AND CALL MP40G TO PRINT
      CALL MPOUTE (X, R(I2+1), J, N+2)
      R(I2) = J
      CALL MP40G (N+3, R(I2))
      RETURN
      END
      SUBROUTINE MP40G (N, X)                                           MP054090
C WRITES X(1), ... , X(N) ON UNIT LUN, CALLED BY MP40F
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1), X(N)
C FOLLOWING IS USUALLY FASTER THAN USING AN IMPLIED DO LOOP
C BUT DOES NOT WORK WITH RALPH COMPILER ON UNIVAC 1100
C COMPUTERS, WHEN IT SHOULD BE REPLACED BY IMPLIED DO LOOP.
      WRITE (LUN, 10) X
   10 FORMAT (1X, I6, 1X, 13A1, 4(1X, 10A1) /
     $ (11X, 10A1, 1X, 10A1, 1X, 10A1, 1X, 10A1, 1X, 10A1))
      RETURN
C
C
      END
C TEST PROGRAM FOR MP PACKAGE                                           MP054230
C                                                                       MP054240
C THIS PROGRAM COMPUTES THE CONSTANTS GIVEN IN APPENDIX A               MP054250
C OF KNUTH, THE ART OF COMPUTER PROGRAMMING, VOL. 3.                    MP054260
C THE CONSTANTS ARE PRINTED IN THE SAME ORDER AS IN KNUTH.              MP054270
C                                                                       MP054280
C THE CONSTANTS ARE COMPUTED TO 40 DECIMAL PLACES, BUT                  MP054290
C TO INCREASE THE ACCURACY IT IS ONLY NECESSARY TO CHANGE               MP054300
C THE STATEMENT IDECPL = 40, AND POSSIBLY                               MP054310
C THE PARAMETERS OF THE CALL TO MPSET AND THE DIMENSIONS                MP054320
C OF THE ARRAYS (SEE TESTV PROGRAM).                                    MP054330
C                                                                       MP054340
C TO RUN TEST THE FOLLOWING MP ROUTINES ARE REQUIRED -                  MP054350
C MPABS, MPADD, MPADDI, MPADDQ, MPADD2, MPADD3, MPART1, MPCHK,          MP054360
C MPCIM, MPCLR, MPCMF, MPCMI, MPCMPI, MPCMPR, MPCMR, MPCOMP, MPCOS,     MP054370
C MPCQM, MPCRM, MPDIV, MPDIVI, MPERR, MPEUL, MPEXP, MPEXP1, MPEXT,      MP054380
C MPGAMQ, MPGCD, MPLN, MPLNI, MPLNS, MPL235, MPMAXR, MPMLP,             MP054390
C MPMUL, MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2, MPOVFL,          MP054400
C MPPI, MPPWR, MPQPWR, MPREC, MPROOT, MPSET, MPSIN, MPSIN1,             MP054410
C MPSQRT, MPSTR, MPSUB, MPUNFL, MP40D, AND MP40E.                       MP054420
C                                                                       MP054430
C CORRECT OUTPUT (EXCLUDING HEADINGS) IS AS FOLLOWS                     MP054440
C                                                                       MP054450
C      1.4142135623 7309504880 1688724209 6980785697                    MP054460
C      1.7320508075 6887729352 7446341505 8723669428                    MP054470
C      2.2360679774 9978969640 9173668731 2762354406                    MP054480
C      3.1622776601 6837933199 8893544432 7185337196                    MP054490
C      1.2599210498 9487316476 7210607278 2283505703                    MP054500
C      1.4422495703 0740838232 1638310780 1095883919                    MP054510
C      1.1892071150 0272106671 7499970560 4759152930                    MP054520
C      0.6931471805 5994530941 7232121458 1765680755                    MP054530
C      1.0986122886 6810969139 5245236922 5257046475                    MP054540
C      2.3025850929 9404568401 7991454684 3642076011                    MP054550
C      1.4426950408 8896340735 9924681001 8921374266                    MP054560
C      0.4342944819 0325182765 1128918916 6050822944                    MP054570
C      3.1415926535 8979323846 2643383279 5028841972                    MP054580
C      0.0174532925 1994329576 9236907684 8861271344                    MP054590
C      0.3183098861 8379067153 7767526745 0287240689                    MP054600
C      9.8696044010 8935861883 4490999876 1511353137                    MP054610
C      1.7724538509 0551602729 8167483341 1451827975                    MP054620
C      2.6789385347 0774763365 5692940974 6776441287                    MP054630
C      1.3541179394 2640041694 5288028154 5137855193                    MP054640
C      2.7182818284 5904523536 0287471352 6624977572                    MP054650
C      0.3678794411 7144232159 5523770161 4608674458                    MP054660
C      7.3890560989 3065022723 0427460575 0078131803                    MP054670
C      0.5772156649 0153286060 6512090082 4024310422                    MP054680
C      1.1447298858 4940017414 3427351353 0587116473                    MP054690
C      1.6180339887 4989484820 4586834365 6381177203                    MP054700
C      1.7810724179 9019798523 6504103107 1795491696                    MP054710
C      2.1932800507 3801545655 9769659278 7382234616                    MP054720
C      0.8414709848 0789650665 2502321630 2989996226                    MP054730
C      0.5403023058 6813971740 0936607442 9766037323                    MP054740
C      1.2020569031 5959428539 9738161511 4499907650                    MP054750
C      0.4812118250 5960344749 7758913424 3684231352                    MP054760
C      2.0780869212 3502753760 1322606117 7957677422                    MP054770
C      0.3665129205 8166432701 2439158232 6694694543                    MP054780
C                                                                       MP054790
      COMMON  B, T, M, LUN, MXR, R                                      MP054800
C MPLN REQUIRES SPACE 6T+14 AND WE HAVE T .LE. 25                       MP054810
C IF WORDLENGTH AT LEAST 16 BITS.                                       MP054820
C DIMENSIONS CAN BE REDUCED IF WORDLENGTH .GT. 16 BITS.                 MP054830
      INTEGER B, T, R(164)                                              MP054840
C TEMPORARY MP VARIABLES REQUIRE SPACE T+2                              MP054850
      INTEGER X(27), Y(27), PHI(27), PI(27)                             MP054860
C                                                                       MP054870
C SET OUTPUT UNIT = 6 AND WORKING PRECISION TO THE                      MP054880
C EQUIVALENT OF AT LEAST 42 DECIMAL PLACES.  THE OTHER                  MP054890
C PARAMETERS ARE THE DIMENSIONS OF X AND R.                             MP054900
      IDECPL = 40                                                       MP054910
      CALL MPSET (6, IDECPL+2, 27, 164)                                 MP054920
      WRITE (LUN, 5) B, T                                               MP054930
    5 FORMAT (29H1TEST OF MP PACKAGE,   BASE =, I9,                     MP054940
     $        11H,  DIGITS =, I3 ///)                                   MP054950
C                                                                       MP054960
C COMPUTE SQRT(2), SQRT(3), SQRT(5) AND SQRT(10)                        MP054970
      DO 10 I = 2, 5                                                    MP054980
      CALL MPQPWR ((5*I)/4 + 4*(I/5), 1, 1, 2, X)                       MP054990
   10 CALL MP40D (IDECPL, X)                                            MP055000
C COMPUTE 2**(1/3) AND 3**(1/3)                                         MP055010
      DO 20 I = 2, 3                                                    MP055020
      CALL MPQPWR (IABS(I), 1, 1, 3, X)                                 MP055030
   20 CALL MP40D (IDECPL, X)                                            MP055040
C COMPUTE 2**(1/4)                                                      MP055050
      CALL MPQPWR (2, 1, 1, 4, X)                                       MP055060
      CALL MP40D (IDECPL, X)                                            MP055070
C COMPUTE LN(2), LN(3) AND LN(10)                                       MP055080
      DO 30 I = 2, 4                                                    MP055090
      CALL MPLNI (I + 6*(I/4), X)                                       MP055100
   30 CALL MP40D (IDECPL, X)                                            MP055110
C COMPUTE 1/LN(2) AND 1/LN(10)                                          MP055120
C COULD HAVE SAVED ABOVE RESULTS TO SPEED UP HERE                       MP055130
      DO 40 I = 1, 2                                                    MP055140
      CALL MPLNI (8*I - 6, X)                                           MP055150
      CALL MPREC (X, X)                                                 MP055160
   40 CALL MP40D (IDECPL, X)                                            MP055170
C COMPUTE PI, PI/180, 1/PI, PI**2, SQRT(PI)                             MP055180
      CALL MPPI (PI)                                                    MP055190
      CALL MP40D (IDECPL, PI)                                           MP055200
      CALL MPDIVI (PI, 180, Y)                                          MP055210
      CALL MP40D (IDECPL, Y)                                            MP055220
      CALL MPREC (PI, Y)                                                MP055230
      CALL MP40D (IDECPL, Y)                                            MP055240
      CALL MPMUL (PI, PI, Y)                                            MP055250
      CALL MP40D (IDECPL, Y)                                            MP055260
      CALL MPSQRT (PI, Y)                                               MP055270
      CALL MP40D (IDECPL, Y)                                            MP055280
C COMPUTE GAMMA (1/3)                                                   MP055290
      CALL MPGAMQ (1, 3, X)                                             MP055300
      CALL MP40D (IDECPL, X)                                            MP055310
C COMPUTE GAMMA (2/3) FROM GAMMA (1/3) (WE COULD                        MP055320
C ALSO CALL MPGAMQ (2, 3, X))                                           MP055330
      CALL MPQPWR (3, 4, 1, 2, Y)                                       MP055340
      CALL MPMUL (X, Y, X)                                              MP055350
      CALL MPDIV (PI, X, X)                                             MP055360
      CALL MP40D (IDECPL, X)                                            MP055370
C COMPUTE E, 1/E, AND E**2                                              MP055380
      CALL MPCIM (1, X)                                                 MP055390
      CALL MPEXP (X, X)                                                 MP055400
      CALL MP40D (IDECPL, X)                                            MP055410
      CALL MPREC (X, Y)                                                 MP055420
      CALL MP40D (IDECPL, Y)                                            MP055430
      CALL MPMUL (X, X, Y)                                              MP055440
      CALL MP40D (IDECPL, Y)                                            MP055450
C COMPUTE EULERS CONSTANT (GAMMA)                                       MP055460
      CALL MPEUL (X)                                                    MP055470
      CALL MP40D (IDECPL, X)                                            MP055480
C COMPUTE LN(PI), PHI                                                   MP055490
      CALL MPLN (PI, Y)                                                 MP055500
      CALL MP40D (IDECPL, Y)                                            MP055510
      CALL MPQPWR (5, 4, 1, 2, Y)                                       MP055520
      CALL MPADDQ (Y, 1, 2, PHI)                                        MP055530
      CALL MP40D (IDECPL, PHI)                                          MP055540
C COMPUTE EXP(GAMMA)  (GAMMA IS IN X)                                   MP055550
      CALL MPEXP (X, X)                                                 MP055560
      CALL MP40D (IDECPL, X)                                            MP055570
C COMPUTE EXP(PI/4)                                                     MP055580
      CALL MPDIVI (PI, 4, X)                                            MP055590
      CALL MPEXP (X, X)                                                 MP055600
      CALL MP40D (IDECPL, X)                                            MP055610
C COMPUTE SIN(1) AND COS(1)                                             MP055620
      CALL MPCIM (1, X)                                                 MP055630
      CALL MPSIN (X, Y)                                                 MP055640
      CALL MP40D (IDECPL, Y)                                            MP055650
      CALL MPCOS (X, X)                                                 MP055660
      CALL MP40D (IDECPL, X)                                            MP055670
C COMPUTE ZETA(3) USING A SERIES OF GOSPER                              MP055680
C COULD ALSO USE MPZETA (3, X) BUT THIS NEEDS MORE SPACE                MP055690
      CALL MPCQM (5, 4, X)                                              MP055700
      CALL MPSTR (X, Y)                                                 MP055710
      I = 0                                                             MP055720
C COMPUTE UPPER BOUND ON I SO THAT                                      MP055730
C (4*I+2)*(I+1)**2 WILL NOT OVERFLOW BELOW                              MP055740
      IBT = INT(8.0*SQRT(FLOAT(B))) - 1                                 MP055750
      IF (IBT.GT.(B/32)) IBT = B/32                                     MP055760
C LOOP TO SUM SERIES                                                    MP055770
   50 I = I + 1                                                         MP055780
C IF I TOO LARGE THE CALL TO MPMULQ HAS TO BE SPLIT UP                  MP055790
      IF (I.GE.IBT) GO TO 60                                            MP055800
      CALL MPMULQ (Y, -(I**3), (4*I+2)*(I+1)**2, Y)                     MP055810
      GO TO 70                                                          MP055820
C HERE THE ABOVE CALL IS SPLIT UP                                       MP055830
   60 CALL MPMULQ (Y, I, I+1, Y)                                        MP055840
      CALL MPMULQ (Y, I, I+1, Y)                                        MP055850
      CALL MPMULQ (Y, -I, 4*I+2, Y)                                     MP055860
   70 CALL MPADD (X, Y, X)                                              MP055870
C LOOP UNTIL EXPONENT OF Y IS SMALL.  SINCE WE GET AT                   MP055880
C LEAST 2 BITS/TERM, NOT MANY ITERATIONS ARE NECESSARY.                 MP055890
      IF ((Y(1).NE.0).AND.((Y(2)+T).GT.0)) GO TO 50                     MP055900
      CALL MP40D (IDECPL, X)                                            MP055910
C COMPUTE LN(PHI), 1/LN(PHI), AND -LN(LN(2))                            MP055920
      CALL MPLN(PHI, X)                                                 MP055930
      CALL MP40D (IDECPL, X)                                            MP055940
      CALL MPREC (X, X)                                                 MP055950
      CALL MP40D (IDECPL, X)                                            MP055960
      CALL MPLNI (2, X)                                                 MP055970
      CALL MPLN (X, X)                                                  MP055980
      X(1) = -X(1)                                                      MP055990
      CALL MP40D (IDECPL, X)                                            MP056000
      STOP                                                              MP056010
      END                                                               MP056020
C TEST PROGRAM FOR MP PACKAGE (VARIABLE PRECISION VERSION)              MP056040
C                                                                       MP056050
C THIS PROGRAM COMPUTES THE CONSTANTS GIVEN IN APPENDIX A               MP056060
C OF KNUTH, THE ART OF COMPUTER PROGRAMMING, VOL. 3.                    MP056070
C THE CONSTANTS ARE PRINTED IN THE SAME ORDER AS IN KNUTH.              MP056080
C THE CONSTANTS ARE GIVEN TO HIGH PRECISION IN -                        MP056090
C KNUTHS CONSTANTS TO 1000 DECIMAL AND 1100 OCTAL PLACES                MP056100
C (BY R. P. BRENT), ANU COMPUTER CENTRE, TECH. REPORT                   MP056110
C NUMBER 47, 1975 (SUBMITTED TO MATH. COMP. UMT FILE).                  MP056120
C                                                                       MP056130
C THE OUTPUT LOGICAL UNIT NUMBER AND THE NUMBER OF DECIMAL              MP056140
C PLACES FOR WORKING AND OUTPUT ARE READ FROM UNIT 5 IN                 MP056150
C 2I4 FORMAT.  WE ASSUME T .LE. 100, IF NOT THE                         MP056160
C DIMENSION STATEMENTS AND CALL TO MPSET MUST BE CHANGED.               MP056170
C                                                                       MP056180
C SOME EXECUTION TIMES ARE -                                            MP056190
C UNIVAC 1108 (FOR SE1D UNDER EXEC 8)                                   MP056200
C    40D       4.420 SECONDS                                            MP056210
C    60D       6.981                                                    MP056220
C    80D      10.293                                                    MP056230
C   100D      13.970                                                    MP056240
C   200D      42.083                                                    MP056250
C   400D     161.524                                                    MP056260
C  1000D    1065.567                                                    MP056270
C DEC PDP10 (KA10) (F10, NOOPT)                                         MP056280
C    40D      10.98  SECONDS                                            MP056290
C    60D      19.12                                                     MP056300
C    80D      26.74                                                     MP056310
C   100D      36.16                                                     MP056320
C   200D     114.70                                                     MP056330
C   400D     449.52                                                     MP056340
C IBM 360/50 (FTN H, OPT = 2) (SLOWER VERSION THAN CURRENT ONE)         MP056350
C    40D      25.039 SECONDS                                            MP056360
C    60D      42.461                                                    MP056370
C    80D      58.859                                                    MP056380
C   100D      83.166                                                    MP056390
C   200D     259.078                                                    MP056400
C IBM 360/91 (FTN H EXTENDED, OPT = 2) (SLOWER VERSION)                 MP056410
C    40D       2.20 SECONDS                                             MP056420
C IBM 370/168 (FTN H EXTENDED, OPT = 2) (SLOWER VERSION)                MP056430
C    40D       1.66 SECONDS                                             MP056440
C PDP 11/45 (DOS, NO FLOATING-POINT HARDWARE) (SLOWER VERSION)          MP056450
C    40D     128  SECONDS                                               MP056460
C    60D     226                                                        MP056470
C    80D     370                                                        MP056480
C   100D     548                                                        MP056490
C CYBER 76 (FTN 4.2, OPT = 1) (SLOWER VERSION)                          MP056500
C    40D      0.478 SECONDS                                             MP056510
C                                                                       MP056520
C TO RUN TESTV THE FOLLOWING MP ROUTINES ARE REQUIRED -                 MP056530
C MPABS, MPADD, MPADDI, MPADDQ, MPADD2, MPADD3, MPART1, MPCHK,          MP056540
C MPCIM, MPCLR, MPCMF, MPCMI, MPCMPI, MPCMPR, MPCMR, MPCOMP, MPCOS,     MP056550
C MPCQM, MPCRM, MPDIV, MPDIVI, MPERR, MPEUL, MPEXP, MPEXP1, MPEXT,      MP056560
C MPGAMQ, MPGCD, MPLN, MPLNI, MPLNS, MPL235, MPMAXR, MPMLP,             MP056570
C MPMUL, MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2, MPOVFL,          MP056580
C MPPI, MPPWR, MPQPWR, MPREC, MPROOT, MPSET, MPSIN, MPSIN1,             MP056590
C MPSQRT, MPSTR, MPSUB, MPUNFL, MP40D, MP40E, AND TIMEMP.               MP056600
C SEE COMMENTS IN TIMEMP BEFORE RUNNING TESTV.                          MP056610
C                                                                       MP056620
      COMMON  B, T, M, LUN, MXR, R                                      MP056630
C MPLN REQUIRES SPACE 6T+14 AND WE HAVE T .LE. 100                      MP056640
      INTEGER B, T, R(614)                                              MP056650
C TEMPORARY MP VARIABLES REQUIRE SPACE T+2                              MP056660
      INTEGER X(102), Y(102), PHI(102), PI(102)                         MP056670
C                                                                       MP056680
C READ OUTPUT UNIT AND PRECISION FROM UNIT 5,                           MP056690
C STOPPING IF SECOND NUMBER IS .LE. 0                                   MP056700
   10 READ (5, 20) LUN1, IDECPL                                         MP056710
   20 FORMAT (2I4)                                                      MP056720
      IF (IDECPL.LE.0) STOP                                             MP056730
      LUN = LUN1                                                        MP056741
C ASSUMED THAT TIMEMP(0) GIVES TIME USED OR TIME OF DAY IN              MP056750
C FLOATING-POINT SECONDS.                                               MP056760
      T1 = TIMEMP(0)                                                    MP056770
      CALL MPSET (LUN1, IDECPL, 102, 614)                               MP056780
      WRITE (LUN, 25) B, T                                              MP056790
   25 FORMAT (30H1TESTV OF MP PACKAGE,   BASE =, I9,                    MP056800
     $        11H,  DIGITS =, I3 ///)                                   MP056810
C                                                                       MP056820
C COMPUTE SQRT(2), SQRT(3), SQRT(5) AND SQRT(10)                        MP056830
      DO 30 I = 2, 5                                                    MP056840
      CALL MPQPWR ((5*I)/4 + 4*(I/5), 1, 1, 2, X)                       MP056850
   30 CALL MP40D (IDECPL, X)                                            MP056860
C COMPUTE 2**(1/3) AND 3**(1/3)                                         MP056870
      DO 40 I = 2, 3                                                    MP056880
      CALL MPQPWR (IABS(I), 1, 1, 3, X)                                 MP056890
   40 CALL MP40D (IDECPL, X)                                            MP056900
C COMPUTE 2**(1/4)                                                      MP056910
      CALL MPQPWR (2, 1, 1, 4, X)                                       MP056920
      CALL MP40D (IDECPL, X)                                            MP056930
C COMPUTE LN(2), LN(3) AND LN(10)                                       MP056940
      DO 50 I = 2, 4                                                    MP056950
      CALL MPLNI (I + 6*(I/4), X)                                       MP056960
   50 CALL MP40D (IDECPL, X)                                            MP056970
C COMPUTE 1/LN(2) AND 1/LN(10)                                          MP056980
C COULD HAVE SAVED ABOVE RESULTS TO SPEED UP HERE                       MP056990
      DO 60 I = 1, 2                                                    MP057000
      CALL MPLNI (8*I - 6, X)                                           MP057010
      CALL MPREC (X, X)                                                 MP057020
   60 CALL MP40D (IDECPL, X)                                            MP057030
C COMPUTE PI, PI/180, 1/PI, PI**2, SQRT(PI)                             MP057040
      CALL MPPI (PI)                                                    MP057050
      CALL MP40D (IDECPL, PI)                                           MP057060
      CALL MPDIVI (PI, 180, Y)                                          MP057070
      CALL MP40D (IDECPL, Y)                                            MP057080
      CALL MPREC (PI, Y)                                                MP057090
      CALL MP40D (IDECPL, Y)                                            MP057100
      CALL MPMUL (PI, PI, Y)                                            MP057110
      CALL MP40D (IDECPL, Y)                                            MP057120
      CALL MPSQRT (PI, Y)                                               MP057130
      CALL MP40D (IDECPL, Y)                                            MP057140
C COMPUTE GAMMA (1/3)                                                   MP057150
      CALL MPGAMQ (1, 3, X)                                             MP057160
      CALL MP40D (IDECPL, X)                                            MP057170
C COMPUTE GAMMA (2/3) FROM GAMMA (1/3) (WE COULD                        MP057180
C ALSO CALL MPGAMQ (2, 3, X))                                           MP057190
      CALL MPQPWR (3, 4, 1, 2, Y)                                       MP057200
      CALL MPMUL (X, Y, X)                                              MP057210
      CALL MPDIV (PI, X, X)                                             MP057220
      CALL MP40D (IDECPL, X)                                            MP057230
C COMPUTE E, 1/E, AND E**2                                              MP057240
      CALL MPCIM (1, X)                                                 MP057250
      CALL MPEXP (X, X)                                                 MP057260
      CALL MP40D (IDECPL, X)                                            MP057270
      CALL MPREC (X, Y)                                                 MP057280
      CALL MP40D (IDECPL, Y)                                            MP057290
      CALL MPMUL (X, X, Y)                                              MP057300
      CALL MP40D (IDECPL, Y)                                            MP057310
C COMPUTE EULERS CONSTANT (GAMMA)                                       MP057320
      CALL MPEUL (X)                                                    MP057330
      CALL MP40D (IDECPL, X)                                            MP057340
C COMPUTE LN(PI), PHI                                                   MP057350
      CALL MPLN (PI, Y)                                                 MP057360
      CALL MP40D (IDECPL, Y)                                            MP057370
      CALL MPQPWR (5, 4, 1, 2, Y)                                       MP057380
      CALL MPADDQ (Y, 1, 2, PHI)                                        MP057390
      CALL MP40D (IDECPL, PHI)                                          MP057400
C COMPUTE EXP(GAMMA)  (GAMMA IS IN X)                                   MP057410
      CALL MPEXP (X, X)                                                 MP057420
      CALL MP40D (IDECPL, X)                                            MP057430
C COMPUTE EXP(PI/4)                                                     MP057440
      CALL MPDIVI (PI, 4, X)                                            MP057450
      CALL MPEXP (X, X)                                                 MP057460
      CALL MP40D (IDECPL, X)                                            MP057470
C COMPUTE SIN(1) AND COS(1)                                             MP057480
      CALL MPCIM (1, X)                                                 MP057490
      CALL MPSIN (X, Y)                                                 MP057500
      CALL MP40D (IDECPL, Y)                                            MP057510
      CALL MPCOS (X, X)                                                 MP057520
      CALL MP40D (IDECPL, X)                                            MP057530
C COMPUTE ZETA(3) USING A SERIES OF GOSPER                              MP057540
C COULD ALSO USE MPZETA (3, X) BUT THIS NEEDS MORE SPACE                MP057550
      CALL MPCQM (5, 4, X)                                              MP057560
      CALL MPSTR (X, Y)                                                 MP057570
      I = 0                                                             MP057580
C COMPUTE UPPER BOUND ON I SO THAT                                      MP057590
C (4*I+2)*(I+1)**2 WILL NOT OVERFLOW BELOW                              MP057600
      IBT = INT(8.0*SQRT(FLOAT(B))) - 1                                 MP057610
      IF (IBT.GT.(B/32)) IBT = B/32                                     MP057620
C LOOP TO SUM SERIES                                                    MP057630
   70 I = I + 1                                                         MP057640
C IF I TOO LARGE THE CALL TO MPMULQ HAS TO BE SPLIT UP                  MP057650
      IF (I.GE.IBT) GO TO 80                                            MP057660
      CALL MPMULQ (Y, -(I**3), (4*I+2)*(I+1)**2, Y)                     MP057670
      GO TO 90                                                          MP057680
C HERE THE ABOVE CALL IS SPLIT UP                                       MP057690
   80 CALL MPMULQ (Y, I, I+1, Y)                                        MP057700
      CALL MPMULQ (Y, I, I+1, Y)                                        MP057710
      CALL MPMULQ (Y, -I, 4*I+2, Y)                                     MP057720
   90 CALL MPADD (X, Y, X)                                              MP057730
C LOOP UNTIL EXPONENT OF Y IS SMALL.  SINCE WE GET AT                   MP057740
C LEAST 2 BITS/TERM, NOT MANY ITERATIONS ARE NECESSARY.                 MP057750
      IF ((Y(1).NE.0).AND.((Y(2)+T).GT.0)) GO TO 70                     MP057760
      CALL MP40D (IDECPL, X)                                            MP057770
C COMPUTE LN(PHI), 1/LN(PHI), AND -LN(LN(2))                            MP057780
      CALL MPLN(PHI, X)                                                 MP057790
      CALL MP40D (IDECPL, X)                                            MP057800
      CALL MPREC (X, X)                                                 MP057810
      CALL MP40D (IDECPL, X)                                            MP057820
      CALL MPLNI (2, X)                                                 MP057830
      CALL MPLN (X, X)                                                  MP057840
      X(1) = -X(1)                                                      MP057850
      CALL MP40D (IDECPL, X)                                            MP057860
C COMPUTE ELAPSED TIME                                                  MP057870
      T1 = TIMEMP(0) - T1                                               MP057880
      WRITE (LUN, 100) IDECPL, T1                                       MP057890
  100 FORMAT (// 18H END OF TEST USING, I5, 16H DECIMAL PLACES,,        MP057900
     $  14H TIME USED WAS, F10.4, 8H SECONDS ///)                       MP057910
      GO TO 10                                                          MP057920
      END                                                               MP057930
C TEST2 PROGRAM FOR MP PACKAGE                                          MP057950
C                                                                       MP057960
C THIS PROGRAM TESTS VARIOUS MP ROUTINES, ESPECIALLY THOSE NOT          MP057970
C CALLED BY PROGRAM TEST.  IT COMPUTES THE CONSTANTS GIVEN IN           MP057980
C COMPUTER APPROXIMATIONS (BY HART, CHENEY, LAWSON, MAEHLY,             MP057990
C MESZTENYI, RICE, THACHER AND WITZGALL, JOHN WILEY, 1968),             MP058000
C APPENDIX C, PP. 182-183, AND VARIOUS OTHER CONSTANTS                  MP058010
C WHICH ARE DESCRIBED IN THE COMMENTS BELOW.  THE CONSTANTS             MP058020
C ARE COMPUTED TO 40 SIGNIFICANT FIGURES, WITH WORKING PRECISION        MP058030
C EQUIVALENT TO AT LEAST 42 SIGNIFICANT FIGURES.  TO INCREASE           MP058040
C THE PRECISION, IT IS ONLY NECESSARY TO ALTER THE STATEMENT            MP058050
C IDECPL = 40, AND PERHAPS INCREASE THE DIMENSIONS OF THE               MP058060
C ARRAYS (AND ALTER THE CALL TO MPSET ACCORDINGLY).                     MP058070
C                                                                       MP058080
C TO RUN TEST2 THE FOLLOWING MP ROUTINES ARE REQUIRED -                 MP058090
C MPABS, MPADD, MPADDI, MPADDQ, MPADD2, MPADD3, MPART1,                 MP058100
C MPASIN, MPATAN, MPBERN, MPBESJ, MPBES2, MPCDM, MPCHK,                 MP058110
C MPCIM, MPCLR, MPCMD, MPCMDE, MPCMEF, MPCMF, MPCMI, MPCMIM,            MP058120
C MPCMPA, MPCMPI, MPCMPR, MPCMR, MPCMRE, MPCOMP, MPCOS,                 MP058130
C MPCOSH, MPCQM, MPCRM, MPDAW, MPDIV, MPDIVI, MPDUMP,                   MP058140
C MPEI, MPEPS, MPERF, MPERFC, MPERF2, MPERF3, MPERR,                    MP058150
C MPEUL, MPEXP, MPEXP1, MPEXT, MPGAM, MPGAMQ, MPGCD,                    MP058160
C MPHANK, MPIN, MPLI, MPLN, MPLNGM, MPLNI, MPLNS, MPL235,               MP058170
C MPMAXR, MPMINR, MPMLP, MPMUL, MPMULI, MPMULQ, MPMUL2,                 MP058180
C MPNEG, MPNZR, MPOUT, MPOUTE, MPOUT2, MPOVFL, MPPACK,                  MP058190
C MPPI, MPPIGL, MPPOLY, MPPWR, MPPWR2, MPQPWR, MPREC,                   MP058200
C MPROOT, MPSET, MPSIN, MPSIN1, MPSINH, MPSQRT, MPSTR, MPSUB,           MP058211
C MPTAN, MPTANH, MPUNFL, MPUNPK, MPZETA, MP40D, MP40E,                  MP058220
C MP40F AND MP40G.                                                      MP058230
C                                                                       MP058240
C CORRECT OUTPUT ON UNIVAC 1108 (EXECUTION TIME 102 SECONDS) IS         MP058251
C AS FOLLOWS.  ON MACHINES WITH WORDLENGTH OTHER THAN 36 BITS           MP058260
C THERE WILL BE SOME MINOR DIFFERENCES.  THE RESULTS GIVEN              MP058270
C BELOW ARE CORRECTLY ROUNDED TO 40 SIGNIFICANT FIGURES.                MP058280
C MOST OUTPUT IS IN FLOATING-POINT FORMAT, WITH THE LEFTMOST            MP058290
C SIGNED INTEGER REPRESENTING THE DECIMAL EXPONENT.  HEADINGS           MP058300
C HAVE BEEN DELETED.                                                    MP058310
C                                                                       MP058320
C     -5  4.8481368110 9535993589 9141023579 479759564                  MP058330
C     -2  1.7453292519 9432957692 3690768488 612713443                  MP058340
C     -1  3.9269908169 8724154807 8304229099 378605246                  MP058350
C     -1  5.6418958354 7756286948 0794515607 725858441                  MP058360
C     -1  6.3661977236 7581343075 5350534900 574481378                  MP058370
C     -1  7.8539816339 7448309615 6608458198 757210493                  MP058380
C     -1  7.9788456080 2865355879 8921198687 637369517                  MP058390
C     -1  9.1893853320 4672741780 3297364056 176398614                  MP058400
C      0  1.5707963267 9489661923 1321691639 751442099                  MP058410
C      0  1.7724538509 0551602729 8167483341 145182798                  MP058420
C      0  2.3561944901 9234492884 6982537459 627163148                  MP058430
C      0  3.1415926535 8979323846 2643383279 502884197                  MP058440
C      0  6.2831853071 7958647692 5286766559 005768394                  MP058450
C     -1  3.6787944117 1442321595 5237701614 608674458                  MP058460
C     -1  7.7880078307 1404868245 1702669783 206472968                  MP058470
C      0  1.2840254166 8774148407 3420568062 436458336                  MP058480
C      0  2.7182818284 5904523536 0287471352 662497757                  MP058490
C     -1  5.7721566490 1532860606 5120900824 024310422                  MP058500
C      0  1.0905077326 6525765920 7010655760 707978993                  MP058510
C      0  1.1892071150 0272106671 7499970560 475915293                  MP058520
C      0  1.4142135623 7309504880 1688724209 698078570                  MP058530
C      0  3.1622776601 6837933199 8893544432 718533720                  MP058540
C      0  1.2599210498 9487316476 7210607278 228350570                  MP058550
C      0  1.5874010519 6819947475 1705639272 308260391                  MP058560
C      0  2.1544346900 3188372175 9293566519 350495259                  MP058570
C      0  4.6415888336 1277889241 0076350919 446576551                  MP058580
C      0  1.4426950408 8896340735 9924681001 892137427                  MP058590
C      0  3.3219280948 8736234787 0319429489 390175865                  MP058600
C     -1  3.4657359027 9972654708 6160607290 882840378                  MP058610
C     -1  6.9314718055 9945309417 2321214581 765680755                  MP058620
C      0  1.3862943611 1989061883 4464242916 353136151                  MP058630
C      0  2.3025850929 9404568401 7991454684 364207601                  MP058640
C     -1  3.0102999566 3981195213 7388947244 930267682                  MP058650
C     -1  4.3429448190 3251827651 1289189166 050822944                  MP058660
C     -1  1.3052619222 0051591548 4062278954 890101937                  MP058670
C     -1  1.9509032201 6128267848 2848684770 222409277                  MP058680
C     -1  2.5881904510 2520762348 8988376240 483283491                  MP058690
C     -1  5.0000000000 0000000000 0000000000 000000000                  MP058700
C     -1  7.0710678118 6547524400 8443621048 490392848                  MP058710
C     -1  8.6602540378 4438646763 7231707529 361834714                  MP058720
C     -1  2.4740395925 4522929596 8487048493 891958934                  MP058730
C     -1  4.7942553860 4203000273 2879352155 713880818                  MP058740
C     -1  8.4147098480 7896506652 5023216302 989996226                  MP058750
C     -1  9.2387953251 1286756128 1831893967 882868224                  MP058760
C     -1  9.6592582628 9068286749 7431997288 973676339                  MP058770
C     -2  9.8491403357 1642530771 9752129132 743229305                  MP058780
C     -1  1.9891236737 9658006911 5976226446 762285979                  MP058790
C     -1  2.6794919243 1122706472 5536584941 276330572                  MP058800
C     -1  4.1421356237 3095048801 6887242096 980785697                  MP058810
C     -1  5.7735026918 9625764509 1487805019 574556476                  MP058820
C      0  1.0000000000 0000000000 0000000000 000000000                  MP058830
C      0  1.7320508075 6887729352 7446341505 872366943                  MP058840
C     -1  2.5534192122 1036266504 4822364904 736782042                  MP058850
C     -1  5.4630248984 3790513255 1794657802 853832976                  MP058860
C      0  1.5574077246 5490223050 6974807458 360173087                  MP058870
C     -1  3.0334668360 7342391675 8839469412 998723842                  MP058880
C     -1  5.3451113595 0791641089 6859612953 629085820                  MP058890
C     -1  6.6817863791 9298919997 7576865230 807615525                  MP058900
C     -1  8.2067879082 8660330972 2819853310 115987674                  MP058910
C      0  1.2185035255 8797634479 5477230620 364055963                  MP058920
C      0  1.4966057626 6548901760 1135134942 476918692                  MP058930
C      0  1.8708684117 8938948108 5201334341 524431687                  MP058940
C      0  2.4142135623 7309504880 1688724209 698078570                  MP058950
C      0  3.2965582089 3832042687 8154216826 253709768                  MP058960
C      0  3.7320508075 6887729352 7446341505 872366943                  MP058970
C      0  5.0273394921 2584810451 4975071064 072385737                  MP058980
C      1  1.0153170387 6088604621 0714766341 947220377                  MP058990
C     -1  8.5163191370 4808012700 4060150609 260682003                  MP059000
C     -1  4.7200121576 8234767447 6683878725 009623642                  MP059010
C     -1  3.6318783834 6867331795 5937477889 247216476                  MP059020
C     -1  5.6682408890 5873937711 2449634671 602835403                  MP059030
C    -11  2.3699749040 8242201872 1147551606 796861398                  MP059040
C     -8  2.3266147948 6597645054 6482207237 974647586                  MP059050
C     -1  4.7693627620 4469873381 4183536431 305598090                  MP059060
C     -2  1.0000166674 1671131256 2227707199 038367857                  MP059070
C     -1 -5.2359877559 8298873077 1072305465 838140329                  MP059080
C      0  1.4292568534 7046940048 5532334664 724427105                  MP059090
C     -3  9.9996666866 6523820634 0116209279 548561369                  MP059100
C     -1 -6.4350110879 3284386802 8092287173 226380415                  MP059110
C      0  1.4711276743 0373459185 2875571761 730851855                  MP059120
C     -1  9.9997500015 6249565972 9003899468 320681723                  MP059130
C     -1  9.9750156206 6040032281 2868984747 920848320                  MP059140
C     -1  7.6519768655 7966551449 7175261026 632209093                  MP059150
C     -1 -2.4593576445 1348335197 7608624853 287538296                  MP059160
C     -2  1.9985850304 2231224242 2839095084 899068063                  MP059170
C     -2  2.4786686152 4201745613 3073111569 370878617                  MP059180
C     -3  4.9999375002 6041612413 2622612282 082222967                  MP059190
C     -2  4.9937526036 2419975563 3655243780 648405856                  MP059200
C     -1  4.4005058574 4933515959 6822037189 149131274                  MP059210
C     -2  4.3472746168 8614366697 4876802585 928830627                  MP059220
C     -2 -7.7145352014 1121580326 8549492723 447021161                  MP059230
C     -3  4.7283119070 8952391757 6071901216 916285418                  MP059240
C    -17  2.1701311384 0496728169 3651142150 815094613                  MP059250
C    -11  2.1693639603 7600238063 5265343042 715360913                  MP059260
C     -5  2.0938338002 3892699656 0701453800 780000026                  MP059270
C     -2 -1.4458842084 7851053177 4561260148 174874671                  MP059280
C     -2 -3.3525383144 1766742728 5301848429 116213846                  MP059290
C     -2 -2.4698010934 2024399653 5541028052 587615959                  MP059300
C   -274  2.3685983851 7441006877 9331157930 426751244                  MP059310
C   -201  2.3685191664 6761106989 6185607645 793014427                  MP059320
C   -128  2.3606104831 9718757702 9325106563 488361132                  MP059330
C    -55  1.6882549780 7489050929 6827170625 271452023                  MP059340
C     -2  9.6338173420 5036143761 5884024435 958149431                  MP059350
C     -3  7.1736423526 6012024786 7318411619 579007593                  MP059360
C   -671  1.3009244067 3808212844 5548553616 298220657                  MP059370
C   -507  1.3009048930 1743487288 7808473358 528762111                  MP059380
C   -343  1.2989549894 8331959674 8137632393 071785666                  MP059390
C   -179  1.1179435292 7916543308 5063648308 631625217                  MP059400
C    -22  1.5475552535 5320739136 3466511764 830851880                  MP059410
C     -2  1.1522597512 5390147811 2859948236 454927804                  MP059420
C  -3818  1.9449982621 7044605474 8125826967 690995132                  MP059430
C  -3018  1.9449922523 5362810181 1176793079 875375991                  MP059440
C  -2218  1.9443913643 2201086173 1787302600 779281025                  MP059450
C  -1418  1.8852294189 9992013304 4032342021 032255068                  MP059460
C   -620  8.5269170095 3604701577 6970746427 276966500                  MP059470
C     -2 -2.9872233755 6625895550 6328177917 819328443                  MP059480
C      0 -1.0000000000 0000000000 0000000000 000000000                  MP059490
C      0  2.0000000000 0000000000 0000000000 000000000                  MP059500
C     -3 -5.0002500375 0937828272 7375137642 333908163                  MP059510
C      0 -1.0000000000 0000000000 0000000000 000000000                  MP059520
C      0  2.0000000000 0000000000 0000000000 000000000                  MP059530
C     -2 -5.0253847187 5985280327 4841986071 548588791                  MP059540
C     -1 -8.4270079294 9714869341 2206350826 092592961                  MP059550
C      0  1.8427007929 4971486934 1220635082 609259296                  MP059560
C     -1 -5.3807950691 2768419136 3874204075 567547920                  MP059570
C     -1 -1.1246291601 8284892203 2750717439 683832217                  MP059580
C      0  1.1124629160 1828489220 3275071743 968383222                  MP059590
C     -2 -9.9335992397 8528611497 8869519231 223541097                  MP059600
C     -1  1.1246291601 8284892203 2750717439 683832217                  MP059610
C     -1  8.8753708398 1715107796 7249282560 316167783                  MP059620
C     -2  9.9335992397 8528611497 8869519231 223541097                  MP059630
C     -1  8.4270079294 9714869341 2206350826 092592961                  MP059640
C     -1  1.5729920705 0285130658 7793649173 907407039                  MP059650
C     -1  5.3807950691 2768419136 3874204075 567547920                  MP059660
C      0  1.0000000000 0000000000 0000000000 000000000                  MP059670
C    -45  2.0884875837 6254475700 0786294957 788611561                  MP059680
C     -2  5.0253847187 5985280327 4841986071 548588791                  MP059690
C      0  1.0000000000 0000000000 0000000000 000000000                  MP059700
C  -4346  6.4059614249 2173203902 1339148586 394148214                  MP059710
C     -3  5.0002500375 0937828272 7375137642 333908163                  MP059720
C    -38  3.9935994897 2441414091 9056205879 117156950                  MP059730
C      0  4.1135267188 7363330061 5263770795 138677800                  MP059740
C      3  9.9994228832 3162419080 5737422564 434215028                  MP059750
C      2  3.4470192403 5219895391 8716891440 225225102                  MP059760
C     17  1.2164510040 8832000000 0000000000 000000000                  MP059770
C   2564  4.0238726007 7093773543 7024339230 039857194                  MP059780
C   2566  1.2723011956 9505546418 2244180377 444569507                  MP059790
C     -1  5.0636564110 9758793656 5576104597 854320650                  MP059800
C     -1  8.6231887228 7683934101 9385139508 425355101                  MP059810
C     -1  5.8721391515 6929076677 8096356445 878942588                  MP059820
C     43 -1.3440585709 0806772420 6312775790 006793681                  MP059830
C     43  1.3440585709 0806772420 6312775790 006793681                  MP059840
C      0 -1.0000000000 0000000000 0000000000 000000000                  MP059850
C     -1  5.4402111088 9369813404 7476618513 772816836                  MP059860
C     -1 -8.3907152907 6452452258 8639478240 648345199                  MP059870
C     -1 -6.4836082745 9086671259 1249330098 086768169                  MP059880
C      4 -1.1013232874 7033933772 3652455484 636440290                  MP059890
C      4  1.1013232920 1033231397 2137609043 787996345                  MP059900
C     -1 -9.9999999587 7692763619 5928371382 757410508                  MP059910
C     -1 -8.4147098480 7896506652 5023216302 989996226                  MP059920
C     -1  5.4030230586 8139717400 9366074429 766037323                  MP059930
C      0 -1.5574077246 5490223050 6974807458 360173087                  MP059940
C      0 -1.1752011936 4380145688 2381850595 600815156                  MP059950
C      0  1.5430806348 1524377847 7905620757 061682602                  MP059960
C     -1 -7.6159415595 5764888119 4582826047 935904128                  MP059970
C     -2 -9.9833416646 8281523068 1419841062 202698992                  MP059980
C     -1  9.9500416527 8025766095 5619878038 702948386                  MP059990
C     -1 -1.0033467208 5450545058 0800457811 115368190                  MP060000
C     -1 -1.0016675001 9844025823 7293835219 050235149                  MP060010
C      0  1.0050041680 5580359898 7978442968 341644710                  MP060020
C     -2 -9.9667994624 9558171183 0508367835 218353896                  MP060030
C     -2  9.9833416646 8281523068 1419841062 202698992                  MP060040
C     -1  9.9500416527 8025766095 5619878038 702948386                  MP060050
C     -1  1.0033467208 5450545058 0800457811 115368190                  MP060060
C     -1  1.0016675001 9844025823 7293835219 050235149                  MP060070
C      0  1.0050041680 5580359898 7978442968 341644710                  MP060080
C     -2  9.9667994624 9558171183 0508367835 218353896                  MP060090
C     -1  8.4147098480 7896506652 5023216302 989996226                  MP060100
C     -1  5.4030230586 8139717400 9366074429 766037323                  MP060110
C      0  1.5574077246 5490223050 6974807458 360173087                  MP060120
C      0  1.1752011936 4380145688 2381850595 600815156                  MP060130
C      0  1.5430806348 1524377847 7905620757 061682602                  MP060140
C     -1  7.6159415595 5764888119 4582826047 935904128                  MP060150
C     -1 -5.4402111088 9369813404 7476618513 772816836                  MP060160
C     -1 -8.3907152907 6452452258 8639478240 648345199                  MP060170
C     -1  6.4836082745 9086671259 1249330098 086768169                  MP060180
C      4  1.1013232874 7033933772 3652455484 636440290                  MP060190
C      4  1.1013232920 1033231397 2137609043 787996345                  MP060200
C     -1  9.9999999587 7692763619 5928371382 757410508                  MP060210
C     -1 -5.0636564110 9758793656 5576104597 854320650                  MP060220
C     -1  8.6231887228 7683934101 9385139508 425355101                  MP060230
C     -1 -5.8721391515 6929076677 8096356445 878942588                  MP060240
C     43  1.3440585709 0806772420 6312775790 006793681                  MP060250
C     43  1.3440585709 0806772420 6312775790 006793681                  MP060260
C      0  1.0000000000 0000000000 0000000000 000000000                  MP060270
C     -6 -9.8751540620 1326563229 6229866117 770420857                  MP060280
C      0 -8.6330247045 7459431886 8214839534 681194494                  MP060290
C      0 -8.6332247045 7470542997 9359283979 131307872                  MP060300
C      0 -8.6331747074 9133043168 0769008811 191229212                  MP060310
C      0  1.8948459881 7263778131 7187616717 034389351                  MP060320
C     -1 -2.1942072601 8738420352 0116707114 601577789                  MP060330
C      0 -8.6330747074 9130265390 2916231033 088668742                  MP060340
C      0  1.8953896445 3923568431 1156778727 698692279                  MP060350
C     -1 -2.1934715012 9890999481 7548014468 423170294                  MP060360
C     -5  8.2586924267 5883918192 2758871133 560282243                  MP060370
C      0  3.1572230549 1259066109 7259584500 948433011                  MP060380
C     -1 -1.0755122583 8435580066 9495127853 382606748                  MP060390
C      0  6.1655995047 8729793752 2981752669 522749131                  MP060400
C      3  2.4922289762 4187775913 8440143998 524848990                  MP060410
C     -6 -4.1569689296 8532427740 2859810278 180384346                  MP060420
C      1  3.0126141584 0796299259 0174133903 218497960                  MP060430
C     41  2.7155527448 5387982191 4014642310 825410296                  MP060440
C    -46 -3.6835977616 8203218023 5192620508 118987655                  MP060450
C      2  1.7760965799 0152226687 6406239486 993179786                  MP060460
C    431  1.9720451371 4123830280 9645048412 023552690                  MP060470
C   -438 -5.0708930602 3516654992 7200999685 925144667                  MP060480
C      3  1.2461372158 9938845969 2771107529 059792487                  MP060490
C   4338  8.8076990836 7471444897 0900245119 101084640                  MP060500
C  -4347 -1.1353703396 3107175183 3431428951 800778261                  MP060510
C      0  1.2020569031 5959428539 9738161511 449990765                  MP060520
C      0  1.0823232337 1113819151 6003696541 167902775                  MP060530
C      0  1.0369277551 4336992633 1365486457 034168057                  MP060540
C      0  1.0009945751 2781808533 7145958900 319017006                  MP060550
C      0  1.0000009539 6203387279 6113152038 683449346                  MP060560
C      0  1.0000000000 0090949478 4026388928 253311839                  MP060570
C      1  2.2459157718 3610454734 2715220454 373502759                  MP060580
C      1  3.0958913717 0115855910 0259628453 669451579                  MP060590
C      0  3.1415926535 8979323846 2643383279 502884197                  MP060600
C      1  3.100627660751343                                             MP060610
C      1  3.100627668029982014200000000000                              MP060620
C      1  3.1006276680 299820148                                        MP060630
C     39  5.9154776185 8631224993 5148194956 040327282                  MP060640
C  1              -9     32768     0     0   ...                        MP060650
C  1     -8589934591         1     0     0   ...                        MP060660
C  1      8589934591     65535 65535 65535   ...                        MP060670
C        ************* ********** ********** **********                 MP060680
C      0  0.0000000000 0000000000 0000000000 000000000                  MP060690
C *** OVERFLOW OCCURRED IN MPDIV ***                                    MP060700
C *** CALL TO MPOVFL, MP OVERFLOW OCCURRED ***                          MP060710
C *** EXECUTION TERMINATED BY CALL TO MPERR IN MP VERSION 780802 ***    MP060721
C                                                                       MP060730
      COMMON B, T, M, LUN, MXR, R                                       MP060740
C MPBESJ REQUIRES SPACE 14T+156 AND T.LE.25 FOR WORDLENGTH              MP060750
C AT LEAST 16 BITS.                                                     MP060760
      INTEGER B, T, R(506)                                              MP060770
C T.LE.25 AND MP VARIABLES REQUIRE SPACE T+2.                           MP060780
      INTEGER W(27), X(27), Y(27), Z(27), PI(27)                        MP060790
      DOUBLE PRECISION DX                                               MP060800
C                                                                       MP060810
C FOLLOWING ARE DATA ARRAYS FOR TEST ARGUMENTS                          MP060820
C                                                                       MP060830
      INTEGER J1(3), J2(4), J3(3), J4(4), J5(6), J6(7), J7(12)          MP060840
      INTEGER J8(3), J9(3), J10(3), J11(7), J12(7), J13(8), J14(4)      MP060850
      INTEGER J15(6), J16(6)                                            MP060860
      DATA J1(1), J1(2), J1(3) /16200, 45, 2/                           MP060870
      DATA J2(1), J2(2), J2(3), J2(4) /-1, -4, 4, 1/                    MP060880
      DATA J3(1), J3(2), J3(3) /8, 4, 2/                                MP060890
      DATA J4(1), J4(2), J4(3), J4(4) /2, 4, 10, 100/                   MP060900
      DATA J5(1), J5(2), J5(3) /24, 16, 12/                             MP060910
      DATA J5(4), J5(5), J5(6) /6, 4, 3/                                MP060920
      DATA J6(1), J6(2), J6(3) /32, 16, 12/                             MP060930
      DATA J6(4), J6(5), J6(6), J6(7) /8, 6, 4, 3/                      MP060940
      DATA J7(1), J7(2), J7(3), J7(4) /9, 15, 18, 21/                   MP060950
      DATA J7(5), J7(6), J7(7), J7(8) /27, 30, 33, 36/                  MP060960
      DATA J7(9), J7(10), J7(11), J7(12) /39, 40, 42, 45/               MP060970
      DATA J8(1), J8(2), J8(3) /0, 1, 10/                               MP060980
      DATA J9(1), J9(2), J9(3) /1, -50, 99/                             MP060990
      DATA J10(1), J10(2), J10(3) /4, -300, 4000/                       MP061000
      DATA J11(1), J11(2), J11(3), J11(4) /-101, -13, 1, 33/            MP061010
      DATA J11(5), J11(6), J11(7) /20, 1000, 2001/                      MP061020
      DATA J12(1), J12(2), J12(3) /3, 7, 10000/                         MP061030
      DATA J12(4), J12(5), J12(6), J12(7) /5, 1, 1, 2/                  MP061040
      DATA J13(1), J13(2), J13(3) /1, 9999, 10001/                      MP061050
      DATA J13(4), J13(5), J13(6) /14514, 10, 100/                      MP061060
      DATA J13(7), J13(8) /1000, 10000/                                 MP061070
      DATA J14(1), J14(2), J14(3), J14(4) /-1, 3, -4, 2/                MP061080
      DATA J15(1), J15(2), J15(3) /0, 1, 6/                             MP061090
      DATA J15(4), J15(5), J15(6) /73, 164, 800/                        MP061100
      DATA J16(1), J16(2), J16(3) /3, 4, 5/                             MP061110
      DATA J16(4), J16(5), J16(6) /10, 20, 40/                          MP061120
C                                                                       MP061130
C SET SIGNIFICANT FIGURES FOR OUTPUT                                    MP061140
      IDECPL = 40                                                       MP061150
C USE TWO EXTRA DECIMAL DIGITS FOR WORKING.  THIS IS USUALLY            MP061160
C (BUT NOT ALWAYS) SUFFICIENT TO GIVE CORRECTLY ROUNDED                 MP061170
C RESULTS.  THE OTHER PARAMETERS ARE THE OUTPUT                         MP061180
C LOGICAL UNIT (6), AND DIMENSIONS OF X AND R.                          MP061190
      CALL MPSET (6, IDECPL+2, 27, 506)                                 MP061200
      WRITE (LUN, 3) B, T                                               MP061210
    3 FORMAT (30H1TEST2 OF MP PACKAGE,   BASE =, I9,                    MP061220
     $        11H,  DIGITS =, I3 ///)                                   MP061230
C                                                                       MP061240
C COMPUTE PI USING GAUSS-LAGRANGE METHOD                                MP061250
      CALL MPPIGL (PI)                                                  MP061260
C                                                                       MP061270
C COMPUTE CONSTANTS GIVEN IN HART ET AL, IN APPROXIMATELY THE           MP061280
C SAME ORDER AS GIVEN THERE.                                            MP061290
      WRITE (LUN, 5)                                                    MP061300
    5 FORMAT (/ 42H CONSTANTS IN HART ET AL (ORDER DIFFERENT) /)        MP061310
C                                                                       MP061320
C COMPUTE PI/64800, PI/180, PI/8                                        MP061330
      CALL MPDIVI (PI, 4, Y)                                            MP061340
      DO 10 I = 1, 3                                                    MP061350
      CALL MPDIVI (Y, J1(I), X)                                         MP061360
C WRITE ON UNIT LUN (SEE CALL TO MPSET ABOVE).                          MP061370
   10 CALL MP40F (IDECPL, X)                                            MP061380
C COMPUTE SQRT(1/PI)                                                    MP061390
      CALL MPROOT (PI, -2, X)                                           MP061400
      CALL MP40F (IDECPL, X)                                            MP061410
C COMPUTE 2/PI                                                          MP061420
      CALL MPDIVI (PI, 2, Z)                                            MP061430
      CALL MPREC (Z, Z)                                                 MP061440
      CALL MP40F (IDECPL, Z)                                            MP061450
C PRINT PI/4 (ALREADY IN Y)                                             MP061460
      CALL MP40F (IDECPL, Y)                                            MP061470
C COMPUTE SQRT (2/PI)                                                   MP061480
      CALL MPSQRT (Z, X)                                                MP061490
      CALL MP40F (IDECPL, X)                                            MP061500
C COMPUTE LN(SQRT(2*PI))                                                MP061510
      CALL MPMULI (PI, 2, Z)                                            MP061520
      CALL MPLN (Z, X)                                                  MP061530
      CALL MPDIVI (X, 2, X)                                             MP061540
      CALL MP40F (IDECPL, X)                                            MP061550
C COMPUTE PI/2                                                          MP061560
      CALL MPDIVI (PI, 2, X)                                            MP061570
      CALL MP40F (IDECPL, X)                                            MP061580
C COMPUTE SQRT (PI)                                                     MP061590
      CALL MPSQRT (PI, X)                                               MP061600
      CALL MP40F (IDECPL, X)                                            MP061610
C COMPUTE 3PI/4, PI, 2PI                                                MP061620
      CALL MPMULQ (PI, 3, 4, X)                                         MP061630
      CALL MP40F (IDECPL, X)                                            MP061640
      CALL MP40F (IDECPL, PI)                                           MP061650
      CALL MP40F (IDECPL, Z)                                            MP061660
C COMPUTE EXP(-1), EXP(-1/4), EXP(1/4), EXP(1)                          MP061670
      DO 20 I = 1, 4                                                    MP061680
      CALL MPCQM (1, J2(I), X)                                          MP061690
      CALL MPEXP (X, X)                                                 MP061700
   20 CALL MP40F (IDECPL, X)                                            MP061710
C COMPUTE EULERS CONSTANT                                               MP061720
      CALL MPEUL (X)                                                    MP061730
      CALL MP40F (IDECPL, X)                                            MP061740
C COMPUTE SQRT(SQRT(SQRT(2))), SQRT(SQRT(2)), SQRT(2)                   MP061750
      DO 30 I = 1, 3                                                    MP061760
      CALL MPQPWR (2, 1, 1, J3(I), X)                                   MP061770
   30 CALL MP40F (IDECPL, X)                                            MP061780
C COMPUTE SQRT(10)                                                      MP061790
      CALL MPQPWR (10, 1, 1, 2, X)                                      MP061800
      CALL MP40F (IDECPL, X)                                            MP061810
C COMPUTE CUBE ROOT OF 2, 4, 10, 100                                    MP061820
      DO 40 I = 1, 4                                                    MP061830
      CALL MPQPWR (J4(I), 1, 1, 3, X)                                   MP061840
   40 CALL MP40F (IDECPL, X)                                            MP061850
C COMPUTE LOG2(E), LOG2(10)                                             MP061860
      CALL MPLNI (2, W)                                                 MP061870
      CALL MPREC (W, Y)                                                 MP061880
      CALL MP40F (IDECPL, Y)                                            MP061890
      CALL MPLNI (10, Z)                                                MP061900
      CALL MPMUL (Z, Y, X)                                              MP061910
      CALL MP40F (IDECPL, X)                                            MP061920
C COMPUTE LN(SQRT(2)), LN(2), LN(4), LN(10)                             MP061930
      CALL MPDIVI (W, 2, X)                                             MP061940
      CALL MP40F (IDECPL, X)                                            MP061950
      CALL MP40F (IDECPL, W)                                            MP061960
      CALL MPMULI (W, 2, X)                                             MP061970
      CALL MP40F (IDECPL, X)                                            MP061980
      CALL MP40F (IDECPL, Z)                                            MP061990
C COMPUTE LOG10(2), LOG10(E)                                            MP062000
      CALL MPDIV (W, Z, X)                                              MP062010
      CALL MP40F (IDECPL, X)                                            MP062020
      CALL MPREC (Z, X)                                                 MP062030
      CALL MP40F (IDECPL, X)                                            MP062040
C COMPUTE SIN(PI/J) FOR J = 24, 16, 12, 6, 4, 3                         MP062050
C NOTE - ORDER IS SLIGHTLY DIFFERENT FROM HART ET AL HERE               MP062060
      DO 50 I = 1, 6                                                    MP062070
      CALL MPDIVI (PI, J5(I), X)                                        MP062080
      CALL MPSIN (X, X)                                                 MP062090
   50 CALL MP40F (IDECPL, X)                                            MP062100
C COMPUTE SIN(1/4), SIN(1/2), SIN(1)                                    MP062110
      DO 60 I = 1, 3                                                    MP062120
      CALL MPCQM (1, 2**(3-I), X)                                       MP062130
      CALL MPSIN (X, X)                                                 MP062140
   60 CALL MP40F (IDECPL, X)                                            MP062150
C COMPUTE SIN(3PI/8), SIN(5PI/12)                                       MP062160
      CALL MPMULQ (PI, 3, 8, X)                                         MP062170
      CALL MPSIN (X, X)                                                 MP062180
      CALL MP40F (IDECPL, X)                                            MP062190
      CALL MPMULQ (PI, 5, 12, X)                                        MP062200
      CALL MPSIN (X, X)                                                 MP062210
      CALL MP40F (IDECPL, X)                                            MP062220
C COMPUTE TAN (PI/J) FOR J = 32, 16, 12, 8, 6, 4, 3                     MP062230
C NOTE - ORDER IS SLIGHTLY DIFFERENT FROM HART ET AL                    MP062240
      DO 70 I = 1, 7                                                    MP062250
      CALL MPDIVI (PI, J6(I), X)                                        MP062260
      CALL MPTAN (X, X)                                                 MP062270
   70 CALL MP40F (IDECPL, X)                                            MP062280
C COMPUTE TAN (1/4), TAN (1/2), TAN(1)                                  MP062290
      DO 80 I = 1, 3                                                    MP062300
      CALL MPCQM (1, 2**(3-I), X)                                       MP062310
      CALL MPTAN (X, X)                                                 MP062320
   80 CALL MP40F (IDECPL, X)                                            MP062330
C COMPUTE TAN(J*PI/96) FOR J = 9, 15, 18, 21, 27, 30,                   MP062340
C                              33, 36, 39, 40, 42, 45                   MP062350
      CALL MPDIVI (PI, 96, Y)                                           MP062360
      DO 90 I = 1, 12                                                   MP062370
      CALL MPMULI (Y, J7(I), X)                                         MP062380
      CALL MPTAN (X, X)                                                 MP062390
   90 CALL MP40F (IDECPL, X)                                            MP062400
C COMPUTE J(NU, PI/4) AND J(NU, PI/2) FOR NU = 0, 1, 10                 MP062410
      DO 100 I = 1, 3                                                   MP062420
      CALL MPDIVI (PI, 4, X)                                            MP062430
      CALL MPBESJ (X, J8(I), X)                                         MP062440
      CALL MP40F (IDECPL, X)                                            MP062450
      CALL MPDIVI (PI, 2, X)                                            MP062460
      CALL MPBESJ (X, J8(I), X)                                         MP062470
  100 CALL MP40F (IDECPL, X)                                            MP062480
C COMPUTE ARCERF(1/2) USING NEWTONS METHOD WITH FIRST                   MP062490
C APPROXIMATION 0.4769                                                  MP062500
      CALL MPSQRT (PI, Y)                                               MP062510
      CALL MPDIVI (Y, 2, Y)                                             MP062520
C COMPUTE NUMBER OF ITERATIONS NECESSARY                                MP062530
      ILIM = 1 + INT(ALOG(FLOAT(IDECPL+2)/3E0)/ALOG(2E0))               MP062540
      CALL MPCRM (0.4769E0, X)                                          MP062550
C COULD SAVE TIME BY REDUCING T AT FIRST (SEE EG MPREC)                 MP062560
      DO 110 I = 1, ILIM                                                MP062570
      CALL MPERF (X, Z)                                                 MP062580
      CALL MPADDQ (Z, -1, 2, Z)                                         MP062590
      CALL MPMUL (X, X, W)                                              MP062600
      CALL MPEXP (W, W)                                                 MP062610
      CALL MPMUL (W, Y, W)                                              MP062620
      CALL MPMUL (W, Z, Z)                                              MP062630
  110 CALL MPSUB (X, Z, X)                                              MP062640
      CALL MP40F (IDECPL, X)                                            MP062650
C                                                                       MP062660
C FINISHED WITH CONSTANTS IN HART ET AL, NOW COMPUTE SOME MORE          MP062670
C TO TEST OTHER MP ROUTINES                                             MP062680
C                                                                       MP062690
      WRITE (LUN, 115)                                                  MP062700
  115 FORMAT (/ 26H TEST OF MPASIN AND MPATAN /)                        MP062710
C COMPUTE ASIN(1/100), ASIN(-1/2), ASIN(99/100)                         MP062720
      DO 120 I = 1, 3                                                   MP062730
      CALL MPCQM (J9(I), 100, X)                                        MP062740
      CALL MPASIN (X, X)                                                MP062750
  120 CALL MP40F (IDECPL, X)                                            MP062760
C COMPUTE ATAN(1/100), ATAN(-3/4), ATAN(10)                             MP062770
      DO 130 I = 1, 3                                                   MP062780
      CALL MPCQM (J10(I), 400, X)                                       MP062790
      CALL MPATAN (X, X)                                                MP062800
  130 CALL MP40F (IDECPL, X)                                            MP062810
      WRITE (LUN, 135)                                                  MP062820
  135 FORMAT (/ 15H TEST OF MPBESJ /)                                   MP062830
C COMPUTE J(NU, X) FOR X = 0.01, 0.1, 1, 10, 100, 1000                  MP062840
C                  AND NU = 0, 1, 6, 73, 164, 800                       MP062850
      DO 150 I = 1, 6                                                   MP062860
      DO 140 J = 1, 6                                                   MP062870
      IF (J.LT.3) CALL MPCQM (1, 10**(3-J), X)                          MP062880
      IF (J.GE.3) CALL MPCQM (10**(J-3), 1, X)                          MP062890
C MPBESJ REQUIRES ABS(NU).LE.MAX(B,64), SO SKIP IF THIS IS NOT          MP062900
C TRUE (SHOULD ONLY OCCUR IF WORDLENGTH LESS THAN 24 BITS)              MP062910
      IF (IABS(J15(I)).GT.MAX0(B, 64)) GO TO 150                        MP062920
      CALL MPBESJ (X, J15(I), X)                                        MP062930
  140 CALL MP40F (IDECPL, X)                                            MP062940
  150 CONTINUE                                                          MP062950
      WRITE (LUN, 155)                                                  MP062960
  155 FORMAT (/ 32H TEST OF MPERF, MPERFC AND MPDAW /)                  MP062970
C COMPUTE ERF(X), ERFC(X), AND DAW(X) (DAWSONS INTEGRAL) FOR            MP062980
C X = -100, -10, -1, -0.1, 0.1, 1, 10, 100                              MP062990
      DO 160 I = 1, 8                                                   MP063000
      IF (I.LE.4) CALL MPCQM (10**(4-I), -10, X)                        MP063010
      IF (I.GT.4) CALL MPCQM (10**(I-5), 10, X)                         MP063020
      CALL MPERF (X, Y)                                                 MP063030
      CALL MP40F (IDECPL, Y)                                            MP063040
      CALL MPERFC (X, Y)                                                MP063050
      CALL MP40F (IDECPL, Y)                                            MP063060
      CALL MPDAW (X, Y)                                                 MP063070
  160 CALL MP40F (IDECPL, Y)                                            MP063080
      WRITE (LUN, 165)                                                  MP063090
  165 FORMAT (/ 14H TEST OF MPGAM /)                                    MP063100
C COMPUTE GAMMA(X) FOR X = -101/3, -13/7, 1/10000, 33/5, 20,            MP063110
C                          1000, 2001/2                                 MP063120
      DO 170 I = 1, 7                                                   MP063130
      CALL MPCQM (J11(I), J12(I), X)                                    MP063140
      CALL MPGAM (X, X)                                                 MP063150
  170 CALL MP40F (IDECPL, X)                                            MP063160
      WRITE (LUN, 175)                                                  MP063170
  175 FORMAT (/ 42H TEST OF MPSIN, COS, TAN, SINH, COSH, TANH /)        MP063180
C COMPUTE SIN(X), COS(X), TAN(X), SINH(X), COSH(X) AND TANH(X)          MP063190
C FOR X = -100, -10, -1, -0.1, 0.1, 1, 10, 100                          MP063200
      DO 180 I = 1, 8                                                   MP063210
      IF (I.LE.4) CALL MPCQM (10**(4-I), -10, X)                        MP063220
      IF (I.GT.4) CALL MPCQM (10**(I-5), 10, X)                         MP063230
      CALL MPSIN (X, Y)                                                 MP063240
      CALL MP40F (IDECPL, Y)                                            MP063250
      CALL MPCOS (X, Y)                                                 MP063260
      CALL MP40F (IDECPL, Y)                                            MP063270
      CALL MPTAN (X, Y)                                                 MP063280
      CALL MP40F (IDECPL, Y)                                            MP063290
      CALL MPSINH (X, Y)                                                MP063300
      CALL MP40F (IDECPL, Y)                                            MP063310
      CALL MPCOSH (X, Y)                                                MP063320
      CALL MP40F (IDECPL, Y)                                            MP063330
      CALL MPTANH (X, Y)                                                MP063340
  180 CALL MP40F (IDECPL, Y)                                            MP063350
      WRITE (LUN, 185)                                                  MP063360
  185 FORMAT (/ 22H TEST OF MPLI AND MPEI /)                            MP063370
C COMPUTE LI(X), EI(X), EI(-X) FOR X = 1/10000, 9999/10000,             MP063380
C 10001/10000, 14514/10000, 10, 100, 1000, 10000                        MP063390
      DO 190 I = 1, 8                                                   MP063400
      ID = 10000                                                        MP063410
      IF (I.GT.4) ID = 1                                                MP063420
      CALL MPCQM (J13(I), ID, X)                                        MP063430
      CALL MPLI (X, Y)                                                  MP063440
      CALL MP40F (IDECPL, Y)                                            MP063450
      CALL MPEI (X, Y)                                                  MP063460
      CALL MP40F (IDECPL, Y)                                            MP063470
      CALL MPNEG (X, X)                                                 MP063480
      CALL MPEI (X, Y)                                                  MP063490
  190 CALL MP40F (IDECPL, Y)                                            MP063500
      WRITE (LUN, 195)                                                  MP063510
  195 FORMAT (/ 15H TEST OF MPZETA /)                                   MP063520
C COMPUTE ZETA(I) FOR I = 3, 4, 5, 10, 20, 40                           MP063530
      DO 200 I = 1, 6                                                   MP063540
      CALL MPZETA (J16(I), X)                                           MP063550
  200 CALL MP40F (IDECPL, X)                                            MP063560
      WRITE (LUN, 205)                                                  MP063570
  205 FORMAT (/ 28H TEST OF VARIOUS MP ROUTINES /)                      MP063580
C COMPUTE PI**E USING MPPWR2                                            MP063590
      CALL MPCIM (1, X)                                                 MP063600
      CALL MPEXP (X, X)                                                 MP063610
      CALL MPPWR2 (PI, X, X)                                            MP063620
      CALL MP40F (IDECPL, X)                                            MP063630
C COMPUTE 2*PI**3 - 4*PI**2 + 3*PI - 1 USING MPPOLY                     MP063640
      CALL MPPOLY (PI, X, J14, 4)                                       MP063650
      CALL MP40F (IDECPL, X)                                            MP063660
C CONVERT PI TO CHARACTER FORMAT USING MPOUT, THEN BACK TO              MP063670
C MP FORMAT USING MPIN                                                  MP063680
      I2 = 3*T+12                                                       MP063690
      CALL MPOUT (PI, R(I2), IDECPL+2, IDECPL)                          MP063700
      CALL MPIN (R(I2), X, IDECPL+2, IER)                               MP063710
C IER SHOULD BE ZERO                                                    MP063720
      IF (IER.NE.0) CALL MPERR                                          MP063730
      CALL MP40F (IDECPL, X)                                            MP063740
C CONVERT PI**3 TO EXPONENT AND SINGLE-PRECISION FRACTION               MP063750
      CALL MPPWR (PI, 3, X)                                             MP063760
      CALL MPCMRE (X, N, RX)                                            MP063770
      WRITE (LUN, 210) N, RX                                            MP063780
  210 FORMAT (1X, I6, F19.15)                                           MP063790
C NOW CONVERT TO EXPONENT AND DOUBLE-PRECISION FRACTION                 MP063800
      CALL MPCMDE (X, N, DX)                                            MP063810
      WRITE (LUN, 220) N, DX                                            MP063820
  220 FORMAT (1X, I6, F34.30)                                           MP063830
C CONVERT BACK TO MULTIPLE-PRECISION                                    MP063840
      CALL MPCDM (DX*(10D0**N), X)                                      MP063850
C AND PRINT (NUMBER OF PLACES AGREEMENT DEPENDS ON                      MP063860
C FLOATING-POINT FRACTION LENGTH)                                       MP063870
      CALL MP40F (20, X)                                                MP063880
C COMPUTE INTEGER PART OF PI**80                                        MP063890
      CALL MPPWR (PI, 80, X)                                            MP063900
      CALL MPCMIM (X, X)                                                MP063910
      CALL MP40F (IDECPL, X)                                            MP063920
C DUMP MACHINE-PRECISION, MINREAL AND MAXREAL (THESE DEPEND             MP063930
C ON BASE AND NUMBER OF DIGITS, AND HENCE ON THE WORDLENGTH             MP063940
C OF THE MACHINE USED).                                                 MP063950
      CALL MPEPS (X)                                                    MP063960
      CALL MPDUMP (X)                                                   MP063970
      CALL MPMINR (X)                                                   MP063980
      CALL MPDUMP (X)                                                   MP063990
      CALL MPMAXR (Y)                                                   MP064000
      CALL MPDUMP (Y)                                                   MP064010
C PRINT USING MP40D (Y IS TOO LARGE SO MPOUT GIVES                      MP064020
C ALL ASTERISKS)                                                        MP064030
      CALL MP40D (IDECPL, Y)                                            MP064040
C CAUSE AN MP UNDERFLOW (RESULT Z WILL BE SET TO ZERO BY MPUNFL)        MP064050
      CALL MPMUL (X, X, Z)                                              MP064060
      CALL MP40F (IDECPL, Z)                                            MP064070
C NOW FINISH BY CAUSING AN MP OVERFLOW                                  MP064080
      CALL MPDIV (Y, X, Z)                                              MP064090
C SHOULD NEVER REACH HERE AS EXECUTION TERMINATED BY MPERR              MP064100
      CALL MPDUMP (Z)                                                   MP064110
      STOP                                                              MP064120
      END                                                               MP064130
      FUNCTION TIMEMP (I)                                               MP064150
C CALLED BY TESTV MAIN PROGRAM, SHOULD RETURN THE EXECUTION
C TIME IN FLOATING-POINT SECONDS FROM SOME ARBITRARY POINT.
C THE ARGUMENT I IS A DUMMY
      COMMON B, T, M, LUN, MXR, R
      INTEGER B, T, R(1)
C *** REPLACE THE FOLLOWING STATEMENTS BY SUITABLE MACHINE-
C     DEPENDENT STATEMENTS,
C FOR EXAMPLE -
C
C ON UNIVAC 1108 USE
C     TIMEMP = FLOAT(JOBTIM(0))/1000E0
C
C ON IBM 360 USE
C     TIMEMP = TIMREM(0)    OR    TIMEMP = TIME(0)
C
C ON PDP 11/45 USE
C     CALL TIME (I1, I2)
C     TIMEMP = (FLOAT(I1)*32768.0 + FLOAT(I2))/50.0
C
      WRITE (LUN, 10)
   10 FORMAT (40H *** PLEASE REPLACE FUNCTION TIMEMP WITH,
     $ 33H A MACHINE-DEPENDENT FUNCTION ***)
      TIMEMP = 0E0
      RETURN
C
      END
1
0
0
0
0
0
0                             MP USER'S GUIDE
                              **************
0
0                            RICHARD P. BRENT,
                             COMPUTER CENTRE,
                      AUSTRALIAN NATIONAL UNIVERSITY,
                        BOX 4, CANBERRA, ACT 2600,
                                 AUSTRALIA
0
0                        TECHNICAL REPORT NO. 54,
                  SEPTEMBER 1976 (LAST REVISED AUGUST 1978)
1
0
0
0
0
0                                CONTENTS                        PAGE
                                 ********                        ****
0           1. GENERAL DESCRIPTION OF MP                          1.1
                 RESTRICTIONS AND EFFICIENCY CONSIDERATIONS       1.2
                 HISTORY AND REFERENCES                           1.3
0           2. SUMMARY OF MP ROUTINES                             2.1
0           3. EXAMPLE PROGRAM                                    3.1
0           4. THE AUGMENT INTERFACE                              4.1
                 THE DESCRIPTION DECK                             4.1
                 EXAMPLE PROGRAM (JACOBI) USING AUGMENT           4.3
                 RESERVED WORDS                                   4.5
0           5. INSTALLATION INSTRUCTIONS                          5.1
                 CONVERSION NOTES                                 5.2
0           6. DESCRIPTION OF MP ROUTINES AND TEST PROGRAMS       6.1
                 MP SUBROUTINES                                   6.1
                 MP TEST PROGRAMS                                6.23
0           7. INDEX OF LINE NUMBERS                              7.1
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  1.1
01 GENERAL DESCRIPTION OF MP
 ***************************
0    MP IS A MULTIPLE-PRECISION FLOATING-POINT ARITHMETIC PACKAGE.  IT IS ALMOST
     COMPLETELY MACHINE-INDEPENDENT, AND SHOULD RUN ON ANY MACHINE WITH AN  ANSI
     STANDARD  FORTRAN COMPILER, SUFFICIENT MEMORY, AND A WORDLENGTH OF AT LEAST
     16 BITS.  SOME MODIFICATIONS WOULD BE NECESSARY FOR A  WORDLENGTH  OF  LESS
     THAN 16 BITS.
0    MP HAS BEEN TESTED ON VARIOUS MACHINES INCLUDING A  UNIVAC  1108  (E  LEVEL
     FORTRAN  V),  A UNIVAC 1100/42 (E AND T LEVEL FORTRAN V, ASCII FORTRAN, AND
     RALPH), A DEC 10 (FORTRAN 10 (/NOOPT),  AND  FORTRAN  40),  AN  IBM  360/50
     (FORTRAN  G  AND  FORTRAN H, OPT = 2), AN IBM 360/91 AND 370/168 (FORTRAN H
     EXTENDED, OPT = 2), A CYBER 76 (FTN 4.2, OPT = 1) AND A  PDP  11/45  (DOS).
     THESE  MACHINES  HAVE  EFFECTIVE  INTEGER WORDLENGTHS RANGING FROM 16 TO 48
     BITS.
0    MP  WORKS  WITH NORMALIZED FLOATING-POINT NUMBERS.  THE BASE (B) AND NUMBER
     OF DIGITS (T) ARE ARBITRARY (SUBJECT TO SOME RESTRICTIONS GIVEN BELOW), AND
     MAY BE VARIED DYNAMICALLY.
0    T-DIGIT FLOATING-POINT NUMBERS ARE STORED IN INTEGER  ARRAYS  OF  DIMENSION
     T+2, WITH THE FOLLOWING CONVENTIONS
0          WORD 1 = SIGN (0, -1 OR +1),
           WORD 2 = EXPONENT (TO BASE B),
           WORDS 3 TO T+2 = NORMALIZED FRACTION (ONE BASE B DIGIT PER WORD).
0    NOTE THAT WORDS 2 TO T+2 ARE UNDEFINED IF SIGN = 0.
0    ARITHMETIC IS ROUNDED, AND FOUR GUARD DIGITS  ARE  USED  FOR  ADDITION  AND
     MULTIPLICATION,  SO  THE  CORRECTLY  ROUNDED  RESULT  IS  USUALLY PRODUCED.
     DIVISION, SQRT ETC ARE DONE BY NEWTONS METHOD, BUT GIVE THE EXACT RESULT IF
     IT  CAN  BE  REPRESENTED  WITH T-2 DIGITS. OTHER ROUTINES (MPSIN, MPLN ETC)
     USUALLY GIVE A RESULT Y =  F(X)  WHICH  COULD  BE  OBTAINED  BY  MAKING  AN
     O(B**(1-T))  PERTURBATION  IN  X,  EVALUATING  F  EXACTLY,  THEN  MAKING AN
     O(B**(1-T)) PERTURBATION IN Y.
0    EXPONENTS  CAN  LIE  IN THE RANGE -M, ... , +M INCLUSIVE, WHERE M IS SET BY
     THE USER.  ON UNDERFLOW DURING AN ARITHMETIC OPERATION, THE RESULT  IS  SET
     TO  ZERO BY SUBROUTINE MPUNFL.  ON OVERFLOW SUBROUTINE MPOVFL IS CALLED AND
     EXECUTION IS TERMINATED WITH AN ERROR MESSAGE.
0    ERROR  MESSAGES  ARE  PRINTED  ON LOGICAL UNIT LUN, WHERE LUN IS SET BY THE
     USER, AND THEN EXECUTION IS TERMINATED BY A CALL TO SUBROUTINE  MPERR.   IT
     IS  ASSUMED  THAT  LOGICAL RECORDS OF UP TO 80 CHARACTERS MAY BE WRITTEN ON
     UNIT LUN.  A WORKING ARRAY OF SIZE MXR (SEE  BELOW)  MUST  BE  PROVIDED  IN
     COMMON.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  1.2
0    THE  PARAMETERS  B, T, M, LUN AND MXR ARE PASSED TO THE UTILITY ROUTINES IN
     COMMON, TOGETHER WITH A WORKING ARRAY R WHICH MUST  BE  SUFFICIENTLY  LARGE
     (SEE BELOW).  MOST ROUTINES USE THE STATEMENTS
0          COMMON B, T, M, LUN, MXR, R
           INTEGER B, T, R(1)
0    AND IT IS ASSUMED THAT MXR IS SET TO THE DIMENSION  OF  R  IN  THE  CALLING
     PROGRAM, AND THAT MXR IS SUFFICIENTLY LARGE (SEE SECTION 6).
0  RESTRICTIONS AND EFFICIENCY CONSIDERATIONS
   ******************************************
0    B (THE BASE) MUST BE AT LEAST 2.
0    T (NUMBER OF DIGITS) MUST BE AT LEAST 2.
0    M (EXPONENT RANGE) MUST BE GREATER THAN T AND LESS  THAN  1/4  THE  LARGEST
     MACHINE-REPRESENTABLE INTEGER.
0    8*B**2-1   MUST  BE  NO  GREATER  THAN  THE  LARGEST  MACHINE-REPRESENTABLE
     INTEGER,  AND  THE  INTEGERS 0, 1, ... , B MUST BE EXACTLY REPRESENTABLE AS
     SINGLE-PRECISION FLOATING-POINT NUMBERS.
0    B**(T-1) SHOULD BE AT LEAST 10**7.
0    B AND T MAY BE SET TO GIVE THE EQUIVALENT OF A SPECIFIED NUMBER OF  DECIMAL
     PLACES  BY  CALLING  MPSET  (SEE  SECTION 6), OR MAY BE SET DIRECTLY BY THE
     USER.  IF MPSET IS NOT CALLED, THE USER MUST REMEMBER TO INITIALIZE M,  LUN
     AMD MXR (SEE ABOVE) AS WELL AS B AND T BEFORE CALLING ANY MP ROUTINES.
0    IT WOULD BE POSSIBLE  TO  USE  LABELLED  COMMON  INSTEAD  OF  BLANK  COMMON
     THROUGHOUT,  AND  SET  DEFAULT  INITIALIZATIONS IN A DATA STATEMENT.  BLANK
     COMMON RATHER THAN LABELLED COMMON IS USED FOR WORKING STORAGE ONLY BECAUSE
     A  CURIOUS  RESTRICTION IN THE ANSI (1966) FORTRAN STANDARD REQUIRES THAT A
     LABELLED COMMON BLOCK BE DECLARED WITH THE SAME LENGTH IN  EACH  SUBPROGRAM
     IN WHICH IT IS DECLARED.
0    FOR EFFICIENCY CHOOSE B FAIRLY LARGE, SUBJECT  TO  THE  RESTRICTIONS  GIVEN
     ABOVE.  FOR EXAMPLE, IF THE WORDLENGTH IS
0          48 BITS, COULD USE B = 4194304 OR 1000000,
           36 BITS, COULD USE B = 65536 OR 10000,
           32 BITS, COULD USE B = 16384 OR 10000,
           24 BITS, COULD USE B = 1024 OR 1000,
           18 BITS, COULD USE B = 128 OR 100,
           16 BITS, COULD USE B = 64 OR 10.
0    AVOID MULTIPLICATION AND DIVISION BY MP  NUMBERS,  AS  THESE  TAKE  O(T**2)
     OPERATIONS,  WHEREAS  MULTIPLICATION  AND  DIVISION  BY  (SINGLE-PRECISION)
     INTEGERS TAKE O(T) OPERATIONS.  SEE THE COMMENTS ON  MPDIV,  MPDIVI,  MPMUL
     AND MPMULI IN SECTION 6.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  1.3
0    MP  NUMBERS  USED  AS  ARGUMENTS  OF SUBROUTINES NEED NOT BE DISTINCT.  FOR
     EXAMPLE,
0          CALL MPADD (X, Y, Y)
     AND
           CALL MPEXP (X, X)
0    ARE  ALLOWABLE.  HOWEVER, DISTINCT ARRAYS WHICH OVERLAP SHOULD NOT BE USED.
0    IT IS ASSUMED  THAT  THE  COMPILER  PASSES  ADDRESSES  OF  ARRAYS  USED  AS
     ARGUMENTS IN SUBROUTINE CALLS (I.E., CALL BY REFERENCE), AND DOES NOT CHECK
     FOR ARRAY BOUNDS VIOLATIONS (EITHER FOR ARGUMENTS OR FOR ARRAYS IN COMMON).
     APART  FROM  THESE VIOLATIONS, MP IS WRITTEN IN ANSI STANDARD FORTRAN (ANSI
     X3.9-1966).  THIS HAS  BEEN  CHECKED  BY  THE  PFORT  VERIFIER.   THE  ONLY
     MACHINE-DEPENDENT ROUTINE IS MPUPK (WHICH UNPACKS CHARACTERS STORED SEVERAL
     TO A WORD).  OTHER ROUTINES WHICH MAY REQUIRE TRIVIAL  CHANGES  ARE  MPSET,
     MPINIT AND TIMEMP (SEE COMMENTS IN SECTIONS 4 AND 6 BELOW).
0  HISTORY AND REFERENCES
   **********************
0    THE FIRST WORKING VERSION OF MP (VERSION 731101) WAS WRITTEN BY R. P. BRENT
     IN  NOVEMBER  1973.   BETWEEN  1973  AND  1978  A  CONSIDERABLE  NUMBER  OF
     IMPROVEMENTS AND ADDITIONS WERE MADE.  THE LAST MAJOR REVISION WAS IN APRIL
     1978, WHEN THE AUGMENT INTERFACE ROUTINES (SEE SECTION 4 BELOW) WERE ADDED.
0    FOR AN INTRODUCTION TO THE DESIGN AND PHILOSOPHY OF MP,  SEE  -  A  FORTRAN
     MULTIPLE-PRECISION  ARITHMETIC  PACKAGE  (BY R. P. BRENT), ACM TRANS. MATH.
     SOFTWARE 4  (MARCH  1978),  57-70.   ADDITIONAL  DETAILS  ARE  GIVEN  IN  -
     ALGORITHM  524 - MP, A FORTRAN MULTIPLE-PRECISION ARITHMETIC PACKAGE, IBID,
     71-81, AND SECTION 6 BELOW.
0    A  PREPROCESSOR  (AUGMENT)  WHICH  FACILITATES THE USE OF THE MP PACKAGE IS
     AVAILABLE. SEE  -  AN  AUGMENT  INTERFACE  FOR  BRENTS  MULTIPLE  PRECISION
     ARITHMETIC  PACKAGE  (BY  R.  P.  BRENT,  J.  A.  HOOPER  AND  J. M. YOHE),
     MATHEMATICS RESEARCH CENTER, UNIVERSITY OF WISCONSIN, MADISON, AUGUST  1978
     (SUBMITTED TO ACM TRANS. MATH. SOFTWARE), AND SECTION 4 BELOW.
0    CORRESPONDENCE CONCERNING MP SHOULD  BE  ADDRESSED  TO  DR.  R.  P.  BRENT,
     COMPUTER  CENTRE,  AUSTRALIAN  NATIONAL UNIVERSITY, BOX 4, CANBERRA, A.C.T.
     2600, AUSTRALIA.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  2.1
02 SUMMARY OF MP ROUTINES
 ************************
0    BASIC ARITHMETIC
0          MPADD, MPADDI, MPADDQ, MPDIV, MPDIVI, MPMUL, MPMULI,  MPMULQ,  MPREC,
           MPSUB
0    POWERS AND ROOTS
0          MPPWR, MPPWR2, MPQPWR, MPROOT, MPSQRT
0    ELEMENTARY FUNCTIONS
0          MPASIN,  MPATAN,  MPCOS,  MPCOSH,  MPEXP, MPLN, MPLNGS, MPLNI, MPSIN,
           MPSINH, MPTAN, MPTANH
0    SPECIAL FUNCTIONS
0          MPBESJ, MPDAW, MPEI,  MPERF,  MPERFC,  MPGAM,  MPGAM,  MPGAMQ,  MPLI,
           MPLNGM
0    CONSTANTS
0          MPBERN, MPEPS, MPEUL, MPMAXR, MPMINR, MPPI, MPPIGL, MPZETA
0    INPUT AND OUTPUT
0          MPDUMP, MPIN, MPINE, MPINF, MPOUT, MPOUTE, MPOUTF, MPOUT2
0    CONVERSION
0          MPCAM,  MPCDM,  MPCIM,  MPCMD,  CPCMDE, MPCMEF, MPCMI, MPCMIM, MPCMR,
           MPCMRE, MPCQM, MPCRM
0    COMPARISON
0          MPCMPA, MPCMPI, MPCMPR, MPCOMP, MPEQ, MPGE, MPGT, MPLE, MPLT, MPNE
0    GENERAL UTILITY ROUTINES
0          MPABS, MPCLR, MPCMF, MPGCDA, MPGCDB, MPINIT,  MPKSTR,  MPMAX,  MPMIN,
           MPNEG, MPPACK, MPPOLY, MPSET, MPSTR, MPUNPK
0    ERROR DETECTION AND HANDLING
0          MPCHK, MPERR, MPOVFL, MPUNFL
0    TEST PROGRAMS
0          EXAMPLE, JACOBI, TEST, TESTV, TEST2
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  2.2
0    AUGMENT INTERFACE ROUTINES
0          MPBASA, MPBASB, MPDGA, MPDGB, MPDIGA, MPDIGB, MPEXPA, MPEXPB, MPMEXA,
           MPMEXB, MPSIGA, MPSIGB
0    MISCELLANEOUS ROUTINES USED BY THE ABOVE
0          MPADD2, MPADD3, MPART1, MPBES2, MPERF2, MPERF3, MPEXP1, MPEXT, MPGCD,
           MPHANK, MPIO, MPLNS, MPL235, MPMLP,  MPMUL2,  MPNZR,  MPSIN1,  MPUPK,
           MP40D, MP40E, MP40F, MP40G, TIMEMP
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  3.1
03 EXAMPLE PROGRAM
 *****************
0    C
     C THIS PROGRAM COMPUTES PI AND EXP(PI*SQRT(163/9)) TO 100
     C DECIMAL PLACES, AND EXP(PI*SQRT(163)) TO 90 DECIMAL PLACES,
     C AND WRITES THEM ON LOGICAL UNIT 6.  EXECUTION
     C TIME ON A UNIVAC 1108 (WITH FORTRAN SE1D) IS 1.051 SECONDS.
     C
     C TO RUN EXAMPLE THE FOLLOWING MP ROUTINES ARE REQUIRED - MPABS,
     C MPADD, MPADDI, MPADD2, MPADD3, MPART1, MPCHK, MPCIM, MPCLR, MPCMF,
     C MPCMI, MPCMPR, MPCMR, MPCOMP, MPCQM, MPCRM, MPDIVI, MPERR,
     C MPEXP, MPEXP1, MPGCD, MPLNI, MPL235, MPMAXR, MPMLP, MPMUL,
     C MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2, MPOVFL, MPPI,
     C MPPWR, MPQPWR, MPREC, MPROOT, MPSET, MPSTR, MPSUB, MPUNFL.
     C
     C CORRECT OUTPUT (EXCLUDING HEADINGS) IS AS FOLLOWS
     C
     C                  3.14159265358979323846264338327950288419716939937510
     C                    58209749445923078164062862089986280348253421170680
     C             640320.00000000060486373504901603947174181881853947577148
     C                    57603665918194652218258286942536340815822646477590
     C 262537412640768743.99999999999925007259719818568887935385633733699086
     C                    2707537410378210647910118607312951181346
     C
     C CERTAIN PARAMETERS AND WORKING SPACE IN COMMON.
           COMMON B, T, M, LUN, MXR, R
     C
     C MPEXP REQUIRES 4T+10 WORDS AND WE HAVE T .LE. 62 IF WORDLENGTH
     C AT LEAST 16 BITS, SO 4T+10 .LE. 258.  DIMENSIONS CAN BE REDUCED
     C IF WORDLENGTH IS GREATER THAN 16 BITS.
           INTEGER B, T, R(258)
     C
     C VARIABLES NEED T+2 .LE. 64 WORDS AND ALLOW 110 CHARACTERS FOR
     C DECIMAL OUTPUT
           INTEGER PI(64), X(64), C(110)
     C
     C CALL MPSET TO SET OUTPUT LOGICAL UNIT = 6 AND EQUIVALENT
     C NUMBER OF DECIMAL PLACES TO AT LEAST 110.  THE LAST TWO
     C PARAMETERS ARE THE DIMENSIONS OF PI (OR X) AND R.
           CALL MPSET (6, 110, 64, 258)
     C
     C COMPUTE MULTIPLE-PRECISION PI
           CALL MPPI(PI)
     C
     C CONVERT TO PRINTABLE FORMAT (F110.100) AND WRITE
           CALL MPOUT (PI, C, 110, 100)
           WRITE (LUN, 10) B, T, C
        10 FORMAT (32H1EXAMPLE OF MP PACKAGE,   BASE =, I9,
          $  12H,   DIGITS =, I4 /// 11H PI TO 100D //
          $  11X, 60A1 / 21X, 50A1)
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  3.2
0    C
     C SET X = SQRT(163/9), THEN MULTIPLY BY PI
           CALL MPQPWR (163, 9, 1, 2, X)
           CALL MPMUL (X, PI, X)
     C
     C SET X = EXP(X)
           CALL MPEXP (X, X)
     C
     C CONVERT TO PRINTABLE FORMAT AND WRITE
           CALL MPOUT (X, C, 110, 100)
           WRITE (LUN, 20) C
        20 FORMAT (/ 28H EXP(PI*SQRT(163/9)) TO 100D //
          $        11X, 60A1 / 21X, 50A1)
     C
     C SET X = X**3 = EXP(PI*SQRT(163))
           CALL MPPWR (X, 3, X)
     C
     C WRITE IN FORMAT F110.90
           CALL MPOUT (X, C, 110, 90)
           WRITE (LUN, 30) C
        30 FORMAT (/ 25H EXP(PI*SQRT(163)) TO 90D //
          $        1X, 70A1 / 21X, 40A1)
           STOP
           END
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  4.1
04 THE AUGMENT INTERFACE
 ***********************
0    AUGMENT  IS  A  PREPROCESSOR  WHICH ALLOWS THE INTRODUCTION OF NON-STANDARD
     TYPES  (E.G.  MULTIPLE-PRECISION  NUMBERS)  INTO  FORTRAN  PROGRAMS.    FOR
     DETAILS,  SEE  - THE AUGMENT PRECOMPILER, PARTS 1 AND 2 - (BY F. D. CRARY),
     TECH.  SUMMARY  REPORTS  1469  AND  1470,  MATHEMATICS   RESEARCH   CENTER,
     UNIVERSITY  OF  WISCONSIN, MADISON, DEC. 1974 (REVISED APRIL 1976) AND OCT.
     1975.  SEE ALSO - A VERSATILE PRECOMPILER FOR NONSTANDARD ARITHMETICS - (BY
     F. D. CRARY), TO APPEAR IN ACM TRANS. MATH. SOFTWARE.
0    A DESCRIPTION DECK HAS BEEN  WRITTEN  TO  ENABLE  AUGMENT  TO  BE  USED  IN
     CONJUNCTION  WITH  THE  MP  PACKAGE.   THIS  GREATLY SIMPLIFIES THE TASK OF
     WRITING A PROGRAM FOR A MULTIPLE-PRECISION  COMPUTATION,  OR  CONVERTING  A
     SINGLE (OR DOUBLE) PRECISION ROUTINE TO MULTIPLE PRECISION.
0    FOR EXAMPLE, IF AUGMENT IS USED WE CAN WRITE EXPRESSIONS SUCH AS
0         X = Y + Z*EXP(X+1)/Y
0    WHERE X, Y, AND Z ARE MULTIPLE-PRECISION, INSTEAD OF THE EQUIVALENT
0         CALL MPADDI (X, 1, MPTEMP)
          CALL MPEXP (MPTEMP, MPTEMP)
          CALL MPMUL (Z, MPTEMP, MPTEMP)
          CALL MPDIV (MPTEMP, Y, MPTEMP)
          CALL MPADD (Y, MPTEMP, X)
0    THE AUGMENT INTERFACE  CAN  BE  USED  WITH  MP  VERSION  780420  (OR  LATER
     VERSIONS).   FOR  MORE  DETAILS,  SEE  THE  TECHNICAL  REPORT  - AN AUGMENT
     INTERFACE FOR BRENTS MULTIPLE PRECISION ARITHMETIC  PACKAGE  -  (BY  R.  P.
     BRENT,  J.  A.  HOOPER  AND  J.  M.  YOHE),  MATHEMATICS  RESEARCH  CENTER,
     UNIVERSITY OF WISCONSIN, MADISON, AUGUST 1978 (APPENDIX A OF THIS REPORT IS
     A  CONVENIENT  SUMMARY  OF THE OPERATIONS IMPLEMENTED IN THE MP PACKAGE AND
     THE METHODS OF INVOKING THEM, EITHER DIRECTLY OR VIA AUGMENT.)
0  THE DESCRIPTION DECK
   ********************
0    THE DESCRIPTION DECK WHICH DESCRIBES THE MP PACKAGE IS AS FOLLOWS.
0    *DESCRIBE MULTIPAK
     COMMENT  AUGMENT DESCRIPTION DECK FOR THE MULTIPLE-PRECISION
              ARITHMETIC PACKAGE OF R. P. BRENT, UNIVAC 1100 VERSION.
              THREE TYPES OF VARIABLE ARE DEFINED HERE -
                    MULTIPLE   (STANDARD MULTIPLE-PRECISION NUMBERS),
                    MULTIPAK   (PACKED MULTIPLE-PRECISION NUMBERS), AND
                    INITIALIZE (USED ONLY AS A DEVICE TO PERSUADE
                                AUGMENT TO INITIALIZE THE MP PACKAGE).
              WORKING SPACE SHOULD BE ALLOCATED AND THE MP PACKAGE
              INITIALIZED BY THE DECLARATION
                    INITIALIZE MP
              IN THE MAIN PROGRAM.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  4.2
0             THIS DESCRIPTION DECK ASSUMES THAT MULTIPLE PRECISION NUMBERS
              WILL HAVE NO MORE THAN 10 DIGITS (BASE 65536) FOR A TOTAL
              PRECISION NOT EXCEEDING ABOUT 43 DECIMAL PLACES.  FOR THIS,
              EACH MP NUMBER REQUIRES 12 WORDS (6 IN PACKED FORMAT).
              SEE COMMENTS IN ROUTINE MPINIT FOR THE METHOD OF CHANGING
              THE PRECISION OR ADAPTING TO A MACHINE WITH WORDLENGTH OTHER
              THAN 36 BITS, AND ALSO REGARDING DECLARATION OF BLANK COMMON.
     DECLARE INTEGER(6), KIND SAFE SUBROUTINE, PREFIX MPK
     SERVICE COPY(STR)
     *DESCRIBE MULTIPLE
     DECLARE INTEGER(12), KIND SAFE SUBROUTINE, PREFIX MP
     OPERATOR + (,NULL UNARY, PRV, $), - (NEG, UNARY),
              + (ADD, BINARY3, PRV, $, $, $, COMM), * (MUL),
              - (SUB,,,,,, NONCOMM), / (DIV), ** (PWR2),
              + (ADDI,,,, INTEGER), * (MULI), / (DIVI), ** (PWR),
              .EQ. (EQ, BINARY2, PRV, $, LOGICAL, COMM), .NE. (NE),
              .GE. (GE,,,,, NONCOMM), .GT. (GT), .LE. (LE), .LT. (LT)
     TEST     MPSIGA (SIGA, INTEGER)
     FIELD    SGN (SIGA, SIGB, ($), INTEGER),
              EXPON (EXPA, EXPB), BASE (BASA, BASB), NUMDIG (DIGA, DIGB),
              MAXEXP (MEXA, MEXB), DIGIT (DGA, DGB, ($, INTEGER))
     FUNCTION ABS (ABS, ($), $), ASIN (ASIN), ATAN (ATAN), CMF (CMF),
              CMIM (CMIM), COS (COS), COSH (COSH), DAW (DAW), EI (EI),
              ERF (ERF), ERFC (ERFC), EXP (EXP), EXP1 (EXP1), FRAC (CMF)
              GAM (GAM), INT (CMIM), LI (LI), LN (LN), LOG (LN), LNGM (L
              LNGS (LNGS), LNS (LNS), REC (REC), SIN (SIN), SINH (SINH),
              SQRT (SQRT), TAN (TAN), TANH (TANH),
              ART1 (ART1, (INTEGER)), LN (LNI), LNI (LNI), LOG (LNI),
              ZETA (ZETA), CAM (CAM), CAM (CAM, (HOLLERITH)),
              MAX (MAX, ($, $)), MIN (MIN), GCD (GCDA),
              BESJ (BESJ, ($, INTEGER)), ROOT (ROOT),
              MPINF (INF(SUBROUTINE),($,INTEGER,INTEGER,HOLLERITH),LOGIC
              MPOUTF (OUTF(SUBROUTINE)),
              MPINF (INF(SUBROUTINE), ($, INTEGER, INTEGER, INTEGER)),
              MPOUTF (OUTF(SUBROUTINE)),
              COMP (COMP, ($, $), INTEGER), CMPA (CMPA),
              COMP (CMPI, ($, INTEGER)), COMP (CMPR, ($, REAL)),
              ADDQ (ADDQ, ($, INTEGER, INTEGER), $), MULQ (MULQ),
              QPWR (QPWR, (INTEGER, INTEGER, INTEGER, INTEGER)),
              CQM (CQM, (INTEGER, INTEGER)), CTM (CQM),
              GAM (GAMQ), GAMQ (GAMQ),
              BERN (BERN, (INTEGER, INTEGER), MULTIPAK)
     CONVERSION CTM (CDM, DOUBLE PRECISION, $, UPWARD),
              CTM (CIM, INTEGER), CTM (CRM, REAL),
              CTM (UNPK, MULTIPAK), CTM (CAM, HOLLERITH),
              CTD (CMD(SUBROUTINE), $, DOUBLE PRECISION, DOWNWARD),
              CTI (CMI(SUBROUTINE),, INTEGER),
              CTR (CMR(SUBROUTINE),, REAL), CTP (PACK,, MULTIPAK)
     SERVICE COPY (STR)
     *DESCRIBE INITIALIZE
     DECLARE INTEGER(1), KIND SAFE SUBROUTINE, PREFIX MPI
     SERVICE COPY (STR), INITIAL (NIT)
     COMMENT    END OF AUGMENT DESCRIPTION DECK FOR MP PACKAGE
1                    MP USERS GUIDE (AUGUST 1978)                      P
0  EXAMPLE PROGRAM (JACOBI) USING AUGMENT
   **************************************
0    THE  PROGRAM  WHICH  FOLLOWS ILLUSTRATES THE USE OF THE MP PACKAGE
     AUGMENT INTERFACE.
0    (INSERT MACHINE-DEPENDENT STATEMENTS HERE TO EXECUTE AUGMENT)
0    *BEGIN
     *ENABLE SOURCE, OUTPUT
     C
     C PROGRAM TO VERIFY AN IDENTITY OF JACOBI USING THE MP
     C PACKAGE AND AUGMENT.
     C
     C THE PROGRAM READS A NUMBER X IN FREE-FIELD FORMAT ACCEPTABLE TO
     C MPIN.  IF X IS NON-POSITIVE IT HALTS.  OTHERWISE IT COMPUTES
     C AND PRINTS FN(X), FN(1/X) AND (FN(X)-FN(1/X))/FN(X),
     C WHERE  FN(X) IS THE SUM FROM N = -INFINITY TO +INFINITY OF
     C SQRT(X)*EXP(-PI*(N*X)**2).
     C THE IDENTITY VERIFIED IS   FN(X) = FN(1/X)
     C
     C DECLARE VARIABLES AND INITIALIZE MP PACKAGE.  ON SOME SYSTEMS BLA
     C COMMON MUST BE DECLARED HERE - SEE COMMENTS IN ROUTINE MPINIT.
     C
           LOGICAL ERR
           MULTIPLE X, F1, F2, FN
           INITIALIZE MP
     C
     C READ X FROM UNIT 5 IN (72A1) FORMAT, STOP IF ERROR
     C OR IF X NOT POSITIVE.
     C
        10 IF (MPINF (X, 72, 5, 6H(72A1))) STOP
           IF (X.LE.0) STOP
     C
     C WRITE HEADING, X, FN(X), AND FN(1/X) IN (1X,F50.40) FORMAT
     C
           WRITE (6, 20)
        20 FORMAT (//41H X, FN(X), FN(1/X), (FN(X)-FN(1/X))/FN(X)/)
           ERR = MPOUTF (X, 50, 40, 9H(1X,50A1))
           F1 = FN(X)
           ERR = MPOUTF (F1, 50, 40, 9H(1X,50A1))
           F2 = FN(1/X)
           ERR = MPOUTF (F2, 50, 40, 9H(1X,50A1))
     C
     C WRITE (F1-F2)/F1 IN (1X,F70.60) FORMAT.
     C NOTE THAT AN MP EXPRESSION CAN BE AN ARGUMENT OF MPOUTF.
     C
           ERR = MPOUTF ((F1-F2)/F1, 70, 60, 9H(1X,70A1))
           GO TO 10
           END
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  4.4
0    C
     C MULTIPLE PRECISION FUNCTION FOLLOWS
     C
           FUNCTION FN(X)
     C
     C RETURNS FN(X) = THE SUM FROM N = -INFINITY TO +INFINITY OF
     C SQRT(X)*EXP(-PI*(N*X)**2), ASSUMING X POSITIVE.
     C USES THE OBVIOUS METHOD, SO SLOW IF X SMALL.
     C NOTE THAT X AND FN ARE BOTH TYPE MULTIPLE.
     C
           MULTIPLE FN, X, TM, FAC, PR
           IF (X.LE.0) CALL MPERR
           FN = 0
     C
     C AUGMENT CAN DEAL WITH THE FOLLOWING EXPRESSION AS IT KNOWS THAT X
     C IS TYPE MULTIPLE, SO CALLS MPCAM TO CONVERT 2HPI TO MULTIPLE.
     C
           TM = EXP(-2HPI*X*X)
           PR = TM
           FAC = TM**2
     C
     C LOOP TO SUM INFINITE SERIES
     C WARNING - NUMBER OF ITERATIONS IS PROPORTIONAL TO 1/X
     C
        10 FN = FN + TM
           PR = PR*FAC
           TM = TM*PR
     C
     C TEST FOR CONVERGENCE BY COMPARING EXPONENTS OF FN AND TM.
     C WE COULD ALSO HAVE SAVED THE OLD VALUE OF FN AND SEEN IF
     C STATEMENT 10 CHANGED IT.
     C
           IF (EXPON(FN)-EXPON(TM).LT.NUMDIG(X)) GO TO 10
           FN = SQRT(X)*(2*FN+1)
           RETURN
           END
     *END
0    (INSERT MACHINE-DEPENDENT STATEMENTS HERE TO COMPILE THE OUTPUT
      FROM AUGMENT, LINK WITH PRECOMPILED MP ROUTINES, AND EXECUTE.
      TYPICAL DATA FOLLOWS.)
0    .5
     .3
     10
     1.234567890123456789012345678901234567890123456789
     0
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  4.5
0  RESERVED WORDS
   **************
0    WHEN  WRITING PROGRAMS WHICH USE MP VIA THE AUGMENT INTERFACE, IT IS SAFEST
     TO AVOID USING THE FOLLOWING IDENTIFIERS EXCEPT WITH THEIR RESERVED MEANING
     AS INDICATED BELOW -
0          BASE        SEE DESCRIPTION OF MPBASA AND MPBASB IN SECTION 6.
           CTD         SEE MPCMD.
           CTI         SEE MPCMI.
           CTM         SEE MPCAM, MPCDM, MPCIM, MPCQM, MPCRM, MPUNPK.
           CTP         SEE MPPACK.
           CTR         SEE MPCMR.
           DIGIT       SEE MPDGA AND MPDGB.
           EXPON       SEE MPEXPA AND MPEXPB.
           FRAC        SEE MPCMF.
           GCD         SEE MPGCDA.
           INITIALIZE  SEE MPINIT.
           INT         SEE MPCMIM.
           LOG         SEE MPLN AND MPLNI.
           MAXEXP      SEE MPMEXA AND MPMEXB.
           MPXXXX      (FOR ANY LETTERS OR DIGITS XXXX).
           MULTIPAK    SEE COMMENTS IN DESCRIPTION DECK ABOVE.
           MULTIPLE    SEE COMMENTS IN DESCRIPTION DECK ABOVE.
           NUMDIG      SEE MPDIGA AND MPDIGB.
           SGN         SEE MPSIGA AND MPSIGB.
0    FOR  THE  FOLLOWING,  IF  THE RESERVED WORD IS XXXX, SEE THE DESCRIPTION OF
     MPXXXX IN SECTION 6.
0          ABS, ADDQ, ART1, ASIN, ATAN, BERN, BESJ, CAM, CMF, CMIM, CMPA,  COMP,
           COS,  COSH,  CQM,  DAW,  EI, ERF, ERFC, EXP, EXP1, GAM, GAMQ, LI, LN,
           LNGM, LNGS, LNI, LNS, MAX, MIN, MULQ, QPWR,  REC,  ROOT,  SIN,  SINH,
           SQRT, STR, TAN, TANH, ZETA.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  5.1
05 INSTALLATION INSTRUCTIONS
 ***************************
0    MP IS NORMALLY DISTRIBUTED IN FIVE FILES.
0          FILE 1 - COMMENTS AND EXAMPLE PROGRAM.
           FILE 2 - MP SUBROUTINES (EXCLUDING EXAMPLE AND TEST PROGRAMS).
           FILE 3 - TEST PROGRAMS (NOT USING AUGMENT INTERFACE).
           FILE 4 - THIS USERS GUIDE.
           FILE 5 - AUGMENT DESCRIPTION DECK AND JACOBI PROGRAM USING IT.
0    TO INSTALL MP, READ THESE FIVE FILES.  PRINT FILE 4 (THE USERS GUIDE) USING
     THE FIRST CHARACTER (BLANK, 0 OR 1) AS STANDARD FORTRAN PRINTER CONTROL.
0    CHECK SOURCE OF ROUTINES MPINIT, MPSET, AND  MPUPK  (IN  FILE2),  MAKE  ANY
     NECESSARY  CHANGES, THEN COMPILE ROUTINES IN FILES 2 AND 3 (PREFERABLY WITH
     OPTIMIZATION OPTIONS OFF) AND CHECK YOUR VERSION OF MPUPK.
0    CONVERT  COMPILED ROUTINES FROM FILE 2 INTO A RELOCATABLE LIBRARY.  IF THIS
     IS NOT POSSIBLE, SEE COMMENTS IN THE TEST ROUTINES OR IN SECTION 6 BELOW TO
     FIND OUT WHICH ROUTINES FROM FILE 2 THEY NEED TO RUN.
0    EXECUTE THE PROGRAMS EXAMPLE, TEST AND TEST2 FROM FILE 3 (AFTER LINKING  TO
     REQUIRED  ROUTINES  FROM FILE 2) AND CHECK THAT OUTPUT IS THE SAME AS GIVEN
     IN THE COMMENTS IN THE PROGRAMS OR IN SECTION 6 BELOW.  OUTPUT IS ON UNIT 6
     UNLESS THE FIRST ARGUMENT IN EACH CALL TO MPSET IS CHANGED.
0    IF ALL HAS GONE WELL, TRY RECOMPILING FILE  2  WITH  COMPILER  OPTIMIZATION
     OPTIONS  TURNED ON, AND RERUN TEST PROGRAMS.  ANY PROBLEMS WHICH APPEAR ARE
     PROBABLY DUE TO BUGS IN YOUR COMPILER,  NOT  IN  THE  MP  ROUTINES.   (SUCH
     PROBLEMS  EXIST  WITH  SOME  RELEASES  OF  THE  UNIVAC FTN AND DEC 10 (F10)
     COMPILERS,  FOR  EXAMPLE.)   THE  ROUTINES  WHOSE  OPTIMIZATION   IS   MOST
     WORTHWHILE ARE MPNZR, MPMLP, MPDIVI, MPADD2, MPADD3 AND MPMUL2.
0    IF YOU  WANT  TO  USE  THE  AUGMENT  INTERFACE,  OBTAIN  AUGMENT  FROM  THE
     PROGRAMMING  SERVICES  LIBRARIAN,  MATHEMATICS  RESEARCH CENTER, 610 WALNUT
     STREET, MADISON, WISCONSIN 53706, AND GET IT RUNNING.  THIS SHOULD  NOT  BE
     TOO  HARD IF YOU HAVE A UNIVAC 1100, IBM 360/370, CDC 6000/7000, DEC 10, OR
     HONEYWELL 600/6000, AS  AUGMENT  HAS  ALREADY  BEEN  IMPLEMENTED  ON  THESE
     MACHINES.   (AUGMENT IS WRITTEN MAINLY IN PORTABLE FORTRAN, BUT THERE ARE A
     FEW MACHINE-DEPENDENT ROUTINES.)
0    NEXT,  USE  THE DESCRIPTION DECK SUPPLIED IN FILE 5 AND RUN THE JACOBI TEST
     PROGRAM WHICH FOLLOWS THE DESCRIPTION DECK IN FILE 5 (AFTER INSERTING A FEW
     MACHINE-DEPENDENT  CONTROL  CARDS).   IT  WILL  BE  NECESSARY TO CHANGE THE
     DIMENSION STATEMENTS IN THE DESCRIPTION DECK AND MODIFY ROUTINE  MPINIT  IF
     YOUR MACHINE HAS WORDLENGTH LESS THAN 36 BITS, AND DESIRABLE TO DO LIKEWISE
     IF THE WORDLENGTH IS GREATER THAN 36 BITS.  SEE ALSO THE COMMENTS IN MPINIT
     REGARDING COMMON DECLARATION.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  5.2
0  CONVERSION NOTES
   ****************
0    TO  CONVERT  MPUPK  TO  A  MACHINE WITH NK CHARACTERS PER WORD, NB BITS PER
     CHARACTER, AND WORDLENGTH NB*NK BITS, CHANGE LINE  MP052387  APPROPRIATELY,
     AND REPLACE LINE MP052415 BY
0          TEMP = OR(AND(TEMP, MASK1),
          $          AND(SHL(SOURCE(I), NB*MOD(LFIELD,NK)), MASK2))
     WHERE
           MASK1 = 2**(NB*(NK-1)) - 1,
           MASK2 = BITWISE COMPLEMENT OF MASK1,
           SHL (W, N) GIVES W SHIFTED LEFT N BIT POSITIONS,
           OR (X, Y), AND (X, Y) GIVE BITWISE LOGICAL FUNCTIONS.
0    TO CONVERT MPUPK TO UNIVAC ASCII FORTRAN (FTN), REPLACE LINE MP052387 BY
0          DATA NK /4/, ISTC /0/
0    AND LINE MP052415 BY
0          BITS (TEMP, 1, 9) = BITS (SOURCE(I), 9*MOD(LFIELD,4)+1, 9)
0    TO CONVERT MPUPK TO IBM 360/370 FORTRAN G/H, REPLACE LINE MP052377 BY
0          INTEGER DEST(1), BLANKS, TEMP
           LOGICAL*1 SOURCE(1), TC(4)
           EQUIVALENCE (TC, TEMP)
0    DELETE LINES MP052381 TO MP052389, DELETE LINES MP052401 TO  MP052411,  AND
     REPLACE LINE MP052415 BY
0          TC(1) = SOURCE(K)
0    ALTERNATIVELY,  THE FOLLOWING RECIPE WORKS (INEFFICIENTLY) ON MOST SYSTEMS.
     REPLACE LINES MP052377 TO MP052391 BY
0          INTEGER SOURCE(1), DEST(1)
           DATA IST /1H$/
0    AND REPLACE LINES MP052401 TO MP052425 BY
0          DECODE (K, 5, SOURCE) (DEST(I), I = 1, K)
         5 FORMAT (80A1)
           IF (DEST(K) .EQ. IST) RETURN
        10 LFIELD = K
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  5.3
0    TO CONVERT MPINIT AND THE DESCRIPTION DECK, LET
0          I = DIMENSION  OF  ARRAYS  FOR  MP  VARIABLES  (LINE  MPA00230 OF THE
               DESCRIPTION DECK AND LINE MP032851 OF MPINIT),
0          J = DIMENSION OF ARRAYS FOR PACKED MP VARIABLES (LINE MPA00200 OF THE
               DESCRIPTION DECK),
0          K = DIMENSION OF R IN COMMON (LINES MP032849 AND MP032851 OF MPINIT).
0    SUPPOSE  PRECISION EQUIVALENT TO AT LEAST D DECIMAL PLACES IS REQUIRED ON A
     MACHINE WITH EFFECTIVE WORDLENGTH W BITS (2**(W-1)-1 MUST BE  REPRESENTABLE
     AS A SIGNED INTEGER).
     THEN
           I = T + 2,
           J = INT((T+3)/2),
     AND
           K .LE. MAX (T*T + 15*T + 27, 14*T + 156),
     WHERE
           T = INT (2 + D*LOG(10)/(INT(W/2-2)*LOG(2)))
0    IS THE NUMBER OF (BASE B) DIGITS TO BE  USED  BY  THE  MP  ROUTINES.   (FOR
     SHARPER BOUNDS ON K, SEE THE COMMENTS ON MPBESJ AND MPLNGM IN SECTION 6.)
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.1
06 DESCRIPTION OF MP ROUTINES AND TEST PROGRAMS
 **********************************************
0    WE  ALWAYS GIVE FIRST THE METHOD OF CALLING THE MP ROUTINE DIRECTLY, SECOND
     (THIRD, ...) ALTERNATIVE METHODS  (IF  ANY)  USING  THE  AUGMENT  INTERFACE
     DESCRIBED IN SECTION 4.
0    UNLESS OTHERWISE NOTED, X, Y AND Z DENOTE INTEGER  ARRAYS  REPRESENTING  MP
     VARIABLES  (OFTEN CALLED MP NUMBERS),  ERR AND LV DENOTE LOGICAL VARIABLES,
     I, J, K, L, IX ETC. DENOTE SINGLE-PRECISION INTEGERS,  RX, RY  ETC.  DENOTE
     SINGLE-PRECISION REALS,  AND DX, DY ETC. DENOTE DOUBLE-PRECISION VARIABLES.
0    FOR DEFINITIONS OF B, T, M, LUN, MXR, R ETC. SEE SECTION 1.  SPACE REQUIRED
     MEANS  THE DIMENSION OF R IN COMMON (SEE SECTION 1).  IF NOT SPECIFIED, THE
     SPACE REQUIRED IS NO MORE THAN T+4 WORDS.  MPBESJ, MPGAM  AND  MPLNGM  HAVE
     THE LARGEST SPACE REQUIREMENTS.
0    TIME BOUNDS SUCH AS O(T**2) ARE AS T TENDS TO INFINITY WITH EVERYTHING ELSE
     FIXED.   FOR  THE  DEFINITION  OF  THE FUNCTION M(T) APPEARING IN SOME TIME
     BOUNDS, SEE THE DESCRIPTION OF MPMUL BELOW.
0  MPABS
   *****
     CALL MPABS (X, Y)  OR  Y = ABS (X)
0    SETS Y = ABS(X) FOR MP NUMBERS X AND Y.
0  MPADD
   *****
     CALL MPADD (X, Y, Z)  OR  Z = X + Y
0    ADDS X AND Y, FORMING RESULT IN Z, WHERE X, Y AND Z ARE MP  NUMBERS.   FOUR
     GUARD DIGITS ARE USED, AND THEN R*-ROUNDING (SEE MPADD2).
0  MPADDI
   ******
     CALL MPADDI (X, IY, Z)  OR  Z = X + IY
0    ADDS MP X TO INTEGER IY GIVING MP Z.
     SPACE = 2T+6 (BUT Z(1) MAY BE R(T+5)).
     AUGMENT USERS -  Z = X + IY IS PREFERABLE TO Z = IY + X.
0  MPADDQ
   ******
     CALL MPADDQ (X, I, J, Y)  OR  Z = ADDQ (X, I, J)
0    ADDS THE RATIONAL NUMBER I/J TO MP NUMBER X, MP RESULT IN Y.  SPACE = 2T+6.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.2
0  MPADD2
   ******
     CALL MPADD2 (X, Y, Z, Y1, TRUNC)
0    X,  Y  AND  Z ARE MP NUMBERS, Y1 AND TRUNC ARE INTEGERS.  (TO FORCE CALL BY
     REFERENCE RATHER THAN VALUE/RESULT, Y1 IS DECLARED AS AN  ARRAY,  BUT  ONLY
     Y1(1) IS EVER USED.)  SETS Z = X + Y1(1)*ABS(Y), WHERE Y1(1) = +- Y(1).  IF
     TRUNC IS ZERO R*-ROUNDING IS USED, OTHERWISE TRUNCATION.   (R*-ROUNDING  IS
     DEFINED  IN  KUKI  AND CODI, COMM. ACM 16(1973), 223.  SEE ALSO BRENT, IEEE
     TC-22(1973), 601.)  CALLED BY MPADD AND  MPSUB,  AND  NOT  RECOMMENDED  FOR
     INDEPENDENT USE.
0  MPADD3
   ******
     CALL MPADD3 (X, Y, S, MED, RE)
0    CALLED BY MPADD2, DOES  INNER  LOOPS  OF  ADDITION.   NOT  RECOMMENDED  FOR
     INDEPENDENT USE.
0  MPART1
   ******
     CALL MPART1 (N, Y)  OR  Y = ART1 (N)
0    COMPUTES MP Y = ARCTAN(1/N), ASSUMING INTEGER   N  .GT.  1.    USES  SERIES
     ARCTAN(X) = X - X**3/3 + X**5/5 - ..., SPACE = 2T+6.  CALLED BY MPPI.
0  MPASIN
   ******
     CALL MPASIN (X, Y)  OR  Y = ASIN (X)
0    RETURNS Y = ARCSIN(X), ASSUMING ABS(X) .LE. 1, FOR  MP  NUMBERS  X  AND  Y.
     RESULT  IS IN THE RANGE -PI/2 TO +PI/2.  METHOD IS TO USE MPATAN, SO TIME =
     O(M(T)T).  SPACE = 5T+12.
0  MPATAN
   ******
     CALL MPATAN (X, Y)  OR  Y = ATAN (X)
0    RETURNS  Y = ARCTAN(X) FOR MP X AND Y, USING AN O(M(T)T) METHOD WHICH COULD
     EASILY BE MODIFIED TO AN O(SQRT(T)M(T)) METHOD (AS IN MPEXP1).   RESULT  IS
     IN  THE  RANGE  -PI/2 TO +PI/2.  FOR AN ASYMPTOTICALLY FASTER METHOD, SEE -
     FAST MULTIPLE-PRECISION  EVALUATION  OF  ELEMENTARY  FUNCTIONS  (BY  R.  P.
     BRENT),  J.   ACM  23 (1976), 242-251, AND THE COMMENTS IN MPPIGL.  SPACE =
     5T+12.
0  MPBASA
   ******
     I = MPBASA (X)  OR  I = BASE (X)
0    RETURNS THE MP BASE (FIRST WORD IN COMMON).  X IS A DUMMY MP ARGUMENT.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.3
0  MPBASB
   ******
     CALL MPBASB (I, X)  OR  BASE (X) = I
0    SETS  THE MP BASE (FIRST WORD OF COMMON) TO I.  I SHOULD BE AN INTEGER SUCH
     THAT I .GE. 2 AND (8*I*I-1) IS REPRESENTABLE AS A SINGLE-PRECISION INTEGER.
     X IS A DUMMY MP ARGUMENT (AUGMENT EXPECTS ONE).
0    WARNING  SETTING  THE  BASE  DOES  NOT  CONVERT MP NUMBERS TO THE NEW BASE.
     *******  THIS CAN BE DONE BY CONVERTING TO DECIMAL USING MPOUT (OR MPOUTE),
     CHANGING THE BASE, AND CONVERTING BACK USING MPIN (OR MPINE).
0  MPBERN
   ******
     CALL MPBERN (N, P, X)  OR  X = BERN (N, P)
0    COMPUTES THE BERNOULLI NUMBERS B2 = 1/6, B4 = -1/30, B6 = 1/42, B8 = -1/30,
     B10  =  5/66,  B12  =  -691/2730,  ETC., DEFINED BY THE GENERATING FUNCTION
     Y/(EXP(Y)-1).   N AND P ARE SINGLE-PRECISION INTEGERS,  WITH  2*P .GE. T+2.
     X SHOULD BE A ONE-DIMENSIONAL INTEGER ARRAY OF DIMENSION AT LEAST P*N.  THE
     BERNOULLI  NUMBERS  B2, B4, ... , B(2N) ARE RETURNED IN PACKED FORMAT IN X,
     WITH B(2J) IN LOCATIONS X((J-1)*P+1), ... , X(P*J).  THUS, TO GET B(2J)  IN
     USUAL MP FORMAT IN Y,  ONE  SHOULD   CALL MPUNPK (X(IX), Y)   AFTER CALLING
     MPBERN, WHERE IX = (J-1)*P+1.
 
0    ALTERNATIVELY (SIMPLER BUT  NONSTANDARD)  -  X  MAY  BE  A  TWO-DIMENSIONAL
     INTEGER  ARRAY DECLARED WITH DIMENSION (P, N1), WHERE   N1 .GE. N   AND 2*P
     .GE.  T+2.    THEN B2, B4, ... , B(2N) ARE RETURNED IN PACKED FORMAT IN  X,
     WITH  B(2J) IN X(1,J), ... , X(P,J).  THUS, TO GET B(2J) IN USUAL MP FORMAT
     IN Y ONE SHOULD CALL MPUNPK (X(1, J), Y) AFTER CALLING MPBERN.
0    AUGMENT USERS - DECLARE
0          MULTIPAK X(N1)
0    WHERE   N1  .GE.  N,   AND USE  P = (NUMDIG(Y)+3)/2  AS THE SECOND ARGUMENT
     (HERE Y IS A DUMMY OF TYPE MULTIPLE), ASSUMING THAT THE  NUMBER  OF  DIGITS
     HAS NOT BEEN CHANGED BETWEEN INITIALIZATION AND THE COMPUTATION OF P.
 
     THE  WELL-KNOWN  RECURRENCE  IS  UNSTABLE (LOSING ABOUT 2J BITS OF RELATIVE
     ACCURACY IN THE COMPUTED B(2J)), SO WE USE A DIFFERENT  RECURRENCE  DERIVED
     BY EQUATING COEFFICIENTS IN
0          (EXP(Y)+1)*(2Y/(EXP(2Y)-1)) = 2Y/(EXP(Y)-1) .
0    THE RELATION
0          B(2J) = -2*((-1)**J)*FACTORIAL(2J)*ZETA(2J)/((2*PI)**(2J))
0    USED  IF ZETA(2J) IS EQUAL TO 1 TO WORKING ACCURACY.  THE RELATIVE ERROR IN
     B(2J) IS O((J**2)*(B**(1-T))).  TIME = O(T*(MIN(N,T)**2) + N*M(T)), SPACE =
     8T+18.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.4
0  MPBESJ
   ******
     CALL MPBESJ (X, NU, Y)  OR  Y = BESJ (X, NU)
0    RETURNS  Y = J(NU,X), THE FIRST-KIND BESSEL FUNCTION OF ORDER NU, FOR SMALL
     INTEGER NU, MP X AND Y.  ABS(NU)  MUST  BE  .LE.  MAX(B,  64).   METHOD  IS
     HANKELS  ASYMPTOTIC  EXPANSION  IF ABS(X) LARGE, THE POWER SERIES IF ABS(X)
     SMALL, AND THE BACKWARD RECURRENCE METHOD OTHERWISE.  RESULTS FOR  NEGATIVE
     ARGUMENTS  ARE  DEFINED BY J(-NU,X) = J(NU,-X) = ((-1)**NU)*J(NU,X).  ERROR
     COULD BE INDUCED BY O(B**(1-T)) PERTURBATIONS IN X AND Y.  TIME =  O(M(T)T)
     FOR  FIXED  X AND NU, INCREASES AS X AND NU INCREASE, UNLESS X LARGE ENOUGH
     FOR ASYMPTOTIC SERIES TO BE USED.   SPACE = 14T+156.
0  MPBES2
   ******
     CALL MPBES2 (X, NU, Y)
0    USES  THE BACKWARD RECURRENCE METHOD TO EVALUATE Y = J(NU,X), WHERE X AND Y
     ARE MP NUMBERS, NU (THE INDEX) IS AN INTEGER, AND J IS THE BESSEL  FUNCTION
     OF  THE  FIRST  KIND.   ASSUMES THAT 0 .LE. NU .LE. MAX(B,64) AND X .GT. 0.
     ALSO ASSUMED THAT  X  CAN  BE  CONVERTED  TO  REAL  WITHOUT  FLOATING-POINT
     OVERFLOW  OR UNDERFLOW.  FOR NORMALIZATION THE IDENTITY J(0,X) + 2*J(2,X) +
     2*J(4,X) + ... = 1  IS USED.  CALLED BY  MPBESJ  AND  NOT  RECOMMENDED  FOR
     INDEPENDENT USE.  SPACE = 8T+18.
0  MPCAM
   *****
     CALL MPCAM (A, X)  OR  X = CTM (A)  OR  X = CAM (A)
0    CONVERTS THE HOLLERITH STRING A TO AN MP NUMBER X.  A CAN BE  A  STRING  OF
     DIGITS  ACCEPTABLE  TO  ROUTINE  MPIN  AND TERMINATED BY A DOLLAR ($), E.G.
     7H-5.367$, OR ONE OF THE FOLLOWING SPECIAL STRINGS
           EPS  (MP MACHINE-PRECISION, SEE MPEPS),
           EUL  (EULERS CONSTANT 0.5772..., SEE MPEUL),
           MAXR (LARGEST VALID MP NUMBER, SEE MPMAXR),
           MINR (SMALLEST POSTIVE MP NUMBER, SEE MPMINR),
           PI   (PI = 3.14..., SEE MPPI).
     ACTUALLY,  ONLY  THE  FIRST  TWO  CHARACTERS  OF  THESE SPECIAL STRINGS ARE
     SIGNIFICANT.  SPACE REQUIRED IS NO MORE  THAN  5*T+L+14,  WHERE  L  IS  THE
     NUMBER  OF  CHARACTERS  IN THE STRING A (EXCLUDING $).  IF MXR IS LESS THAN
     3*T+L+11 THE STRING A WILL EFFECTIVELY BE TRUNCATED.
0    WARNING  AUGMENT USERS -  USE CAM(A) AND NOT CTM(A) IF A IS DECLARED AS  AN
     *******  INTEGER ARRAY.
0  MPCDM
   *****
     CALL MPCDM (DX, Z)  OR  Z = DX  OR  Z = CTM (DX)
0    CONVERTS DOUBLE-PRECISION DX TO  MP  Z.   SOME  NUMBERS  WILL  NOT  CONVERT
     EXACTLY  ON  MACHINES  WITH  BASE  OTHER  THAN  TWO, FOUR OR SIXTEEN.  THIS
     ROUTINE IS NOT CALLED BY ANY OTHER ROUTINE IN MP,  SO  MAY  BE  OMITTED  IF
     DOUBLE-PRECISION IS NOT AVAILABLE.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.5
0  MPCHK
   *****
     CALL MPCHK (I, J)
0    CHECKS  LEGALITY OF B, T, M, MXR AND LUN WHICH SHOULD BE SET IN COMMON (SEE
     SECTION 1).  THE CONDITION ON MXR (THE DIMENSION OF R IN  COMMON)  IS  THAT
     MXR .GE. (I*T + J).
0  MPCIM
   *****
     CALL MPCIM (IX, Z)  OR  Z = IX  OR  Z = CTM (IX)
0    CONVERTS INTEGER IX TO MP Z.  NOTE - IX SHOULD NOT BE THE SAME LOCATION  AS
     Z(1) IN CALL.
0  MPCLR
   *****
     CALL MPCLR (X, N)
0    SETS X(T+3), ... , X(N+2) TO ZERO.  USEFUL IF  PRECISION  IS  GOING  TO  BE
     INCREASED.
0  MPCMD
   *****
     CALL MPCMD (X, DZ)  OR  DZ = X  OR  DZ = CTD (X)
0    CONVERTS MP X TO DOUBLE-PRECISION DZ.  ASSUMES X IS IN ALLOWABLE RANGE  FOR
     DOUBLE-PRECISION  NUMBERS.   THERE IS SOME LOSS OF ACCURACY IF THE EXPONENT
     IS LARGE.
0  MPCMDE
   ******
     CALL MPCMDE (X, N, DX)
0    RETURNS  INTEGER  N  AND  DOUBLE-PRECISION  DX  SUCH  THAT MP  X = DX*10**N
     (APPROXIMATELY), WHERE  1 .LE. ABS(DX) .LT. 10  UNLESS X IS ZERO.   ASSUMED
     THAT X NOT SO LARGE OR SMALL THAT N OVERFLOWS.  SPACE = 6T+14.
0  MPCMEF
   ******
     CALL MPCMEF (X, N, Y)
0    GIVEN MP X, RETURNS INTEGER N AND MP Y SUCH THAT
           X = (10**N)*Y  AND  1 .LE. ABS(Y) .LT. 10
     (UNLESS X .EQ. 0, WHEN N .EQ. 0 AND Y .EQ. 0).  IT IS ASSUMED THAT X IS NOT
     SO LARGE OR SMALL THAT N OVERFLOWS.  SPACE = 5T+12.
0  MPCMF
   *****
     CALL MPCMF (X, Y)  OR  Y = CMF (X)  OR  Y = FRAC (X)
0    FOR MP X AND Y, RETURNS FRACTIONAL PART OF X IN Y,
     I.E.  Y = X - INTEGER PART OF X (TRUNCATED TOWARDS 0).
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.6
0  MPCMI
   *****
     CALL MPCMI (X, IZ)  OR  IZ = X  OR IZ = CTI (X)
0    CONVERTS  MP  X  TO  INTEGER  IZ,  ASSUMING  THAT X NOT TOO LARGE (ELSE USE
     MPCMIM).  X IS TRUNCATED TOWARDS ZERO.   IF  INT(X)  IS  TOO  LARGE  TO  BE
     REPRESENTED  AS  A  SINGLE-PRECISION  INTEGER, IZ IS RETURNED AS ZERO.  THE
     USER MAY CHECK FOR THIS POSSIBILITY BY TESTING IF
           ((X(1).NE.0) .AND. (X(2).GT.0) .AND. (IZ.EQ.0))
     IS TRUE ON RETURN FROM MPCMI.
0  MPCMIM
   ******
     CALL MPCMIM (X, Y)  OR  Y = CMIM (X)  OR  Y = INT (X)
0    RETURNS Y = INTEGER PART OF X (TRUNCATED TOWARDS 0), FOR MP X AND  Y.   USE
     IF Y TOO LARGE TO BE REPRESENTABLE AS A SINGLE-PRECISION INTEGER.
0  MPCMPA
   ******
     J = MPCMPA (X, Y)  OR  J = CMPA (X, Y)
0    COMPARES ABS(X) WITH ABS(Y) FOR MP X AND Y, RETURNING
           +1 IF ABS(X) .GT. ABS(Y),
           -1 IF ABS(X) .LT. ABS(Y),
            0 IF ABS(X) .EQ. ABS(Y).
0  MPCMPI
   ******
     J = MPCMPI (X, I)  OR  J = COMP (X, I)
0    COMPARES MP NUMBER X WITH INTEGER I, RETURNING
           +1 IF X .GT. I,
            0 IF X .EQ. I,
           -1 IF X .LT. I.
     SPACE = 2T+6.
0  MPCMPR
   ******
     J = MPCMPR (X, RI)  OR  J = COMP (X, RI)
0    COMPARES MP NUMBER X WITH REAL NUMBER RI, RETURNING
           +1 IF X .GT. RI,
            0 IF X .EQ. RI,
           -1 IF X .LT. RI.
     SPACE = 2T+6.
0  MPCMR
   *****
     CALL MPCMR (X, RZ)  OR  RZ = X  OR RZ = CTR (X)
0    CONVERTS MP X TO SINGLE-PRECISION RZ.  ASSUMES X IN ALLOWABLE RANGE.  THERE
     IS SOME LOSS OF ACCURACY IF THE EXPONENT IS LARGE.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.7
0  MPCMRE
   ******
     CALL MPCMRE (X, N, RX)
0    RETURNS  INTEGER  N  AND SINGLE-PRECISION REAL RX SUCH THAT MP X = RX*10**N
     (APPROXIMATELY), WHERE  1 .LE. ABS(RX) .LT. 10  UNLESS X IS ZERO.   ASSUMED
     THAT X NOT SO LARGE OR SMALL THAT N OVERFLOWS.  SPACE = 6T+14.
0  MPCOMP
   ******
     J = MPCOMP (X, Y)  OR  J = COMP (X, Y)
0    COMPARES THE MP NUMBERS X AND Y, RETURNING
           +1 IF X .GT. Y,
           -1 IF X .LT. Y,
            0 IF X .EQ. Y.
0  MPCOS
   *****
     CALL MPCOS (X, Y)  OR  Y = COS (X)
0    RETURNS Y = COS(X) FOR MP  X  AND  Y,  USING  MPSIN  AND  MPSIN1.   TIME  =
     O(M(T)T/LOG(T)),  SPACE = 5T+12.
0  MPCOSH
   ******
     CALL MPCOSH (X, Y)  OR  Y = COSH (X)
0    RETURNS MP Y = COSH(X) FOR MP X (NOT TOO LARGE).   TIME  =  O(SQRT(T)M(T)),
     SPACE = 5T+12.
0  MPCQM
   *****
     CALL MPCQM (I, J, Q)  OR  Q = CQM (I, J)  OR  Q = CTM (I, J)
0    CONVERTS THE RATIONAL NUMBER I/J TO MULTIPLE PRECISION Q.
0  MPCRM
   *****
     CALL MPCRM (RX, Z)  OR  Z = RX  OR  Z = CTM (RX)
0    CONVERTS  SINGLE-PRECISION  REAL RX TO MP Z.  SOME NUMBERS WILL NOT CONVERT
     EXACTLY ON MACHINES WITH BASE OTHER THAN TWO, FOUR OR SIXTEEN.
0  MPDAW
   *****
     CALL MPDAW (X, Y)  OR  Y = DAW (X)
0    RETURNS
           Y = DAWSONS INTEGRAL OF MP ARGUMENT X
             = EXP(-X**2)*(INTEGRAL FROM 0 TO X OF EXP(U**2)DU),
0    FOR MP X AND Y.    SPACE = 5T+17.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.8
0  MPDGA
   *****
     I = MPDGA (X, N)  OR  I = DIGIT (X, N)
0    RETURNS THE N-TH DIGIT OF THE MP NUMBER X FOR 1 .LE.  N  .LE.  T.   RETURNS
     ZERO IF X IS ZERO OR N .LE. 0 OR N .GT. T.
0  MPDGB
   *****
     CALL MPDGB (I, X, N)  OR  DIGIT (X, N) = I
0    SETS  THE  N-TH   DIGIT  OF THE MP NUMBER X TO I.    N MUST BE IN THE RANGE
     1  .LE.  N .LE. T,  I MUST BE IN THE RANGE  0 .LE. I .LT. B  (AND  I .NE. 0
     IF  N .EQ. 1).  THE SIGN AND EXPONENT OF X ARE UNCHANGED.
0  MPDIGA
   ******
     I = MPDIGA (X)  OR  I = NUMDIG (X)
0    RETURNS  THE  NUMBER OF MP DIGITS (SECOND WORD IN COMMON).  X IS A DUMMY MP
     ARGUMENT.
0  MPDIGB
   ******
     CALL MPDIGB (I, X)  OR  NUMDIG (X) = I
0    SETS  THE NUMBER OF MP DIGITS (SECOND WORD OF COMMON) TO I.  I SHOULD BE AN
     INTEGER (AT LEAST 2).  X IS A DUMMY MP ARGUMENT (AUGMENT EXPECTS ONE).
0    WARNING  MP  NUMBERS  MUST  BE  DECLARED  AS INTEGER ARRAYS OF DIMENSION AT
     *******  LEAST I+2. MPDIGB DOES NOT CHECK THIS.
0  MPDIV
   *****
     CALL MPDIV (X, Y, Z)  OR  Z = X/Y
0    SETS Z = X/Y, FOR MP X, Y AND Z.  MPERR IS CALLED IF Y IS  ZERO.   SPACE  =
     4T+10 (BUT Z(1) MAY BE R(3T+9)), TIME = O(M(T)).
0  MPDIVI
   ******
     CALL MPDIVI (X, IY, Z)  OR  Z = X/IY
0    DIVIDES MP X BY THE SINGLE-PRECISION INTEGER IY GIVING  MP  Z,  TIME  O(T).
     THIS  IS  MUCH FASTER THAN DIVISION BY AN MP NUMBER.  MPERR IS CALLED IF IY
     IS ZERO.
0  MPDUMP
   ******
     CALL MPDUMP (X)
0    DUMPS  OUT  THE  MP NUMBER X (SIGN, EXPONENT, FRACTION DIGITS) ON UNIT LUN.
     USEFUL FOR DEBUGGING.  EMBEDDED BLANKS SHOULD BE INTERPRETED AS ZEROS.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  6.9
0  MPEI
   ****
     CALL MPEI (X, Y)  OR  Y = EI (X)
0    RETURNS Y = EI(X) = -E1(-X)
               = (PRINCIPAL VALUE INTEGRAL FROM -INFINITY TO X OF EXP(U)/U DU),
0    FOR MP NUMBERS X AND Y, USING  THE  POWER  SERIES  FOR  SMALL  ABS(X),  THE
     ASYMPTOTIC  SERIES  FOR LARGE ABS(X), AND THE CONTINUED FRACTION FOR MEDIUM
     NEGATIVE X.  THE RELATIVE ERROR IN Y IS SMALL UNLESS X IS VERY CLOSE TO THE
     ZERO  0.37250741078136663446...  OF EI(X), AND THEN THE ABSOLUTE ERROR IN Y
     IS O(B**(1-T)).  IN ANY CASE  THE  ERROR  IN  Y  COULD  BE  INDUCED  BY  AN
     O(B**(1-T)) RELATIVE PERTURBATION IN X.  TIME = O(M(T)T), SPACE = 10T+38.
0  MPEPS
   *****
     CALL MPEPS (X)  OR  X = CTM (3HEPS)
0    SETS MP X TO  THE  (MULTIPLE-PRECISION)  MACHINE  PRECISION,  THAT  IS  THE
     SMALLEST POSITIVE NUMBER X SUCH THAT THE COMPUTED VALUE OF 1 + X IS GREATER
     THAN 1 .
0  MPEQ
   ****
     LV = MPEQ (X, Y))  OR  LV = (X .EQ. Y)  OR  IF (X .EQ. Y) ...
0    RETURNS  LOGICAL VALUE OF (X .EQ. Y) FOR MP X AND Y.  MPEQ MUST BE DECLARED
     LOGICAL UNLESS AUGMENT INTERFACE IS USED.
0  MPERF
   *****
     CALL MPERF (X, Y)  OR  Y = ERF (X)
0    RETURNS Y = ERF(X)
               = SQRT(4/PI)*(INTEGRAL FROM 0 TO X OF EXP(-U**2) DU)
0    FOR MP X AND Y,  SPACE = 5T+12.
0  MPERFC
   ******
     CALL MPERFC (X, Y)  OR  Y = ERFC (X)
0    RETURNS Y = ERFC(X) = 1 - ERF(X) FOR MP NUMBERS X AND Y,  USING  MPERF  AND
     MPERF3.   SPACE = 12T+26.
0  MPERF2
   ******
     CALL MPERF2 (X, Y)
0    RETURNS Y = EXP(X**2)*(INTEGRAL FROM 0 TO X OF EXP(-U*U) DU)
0    FOR  MP  NUMBERS X AND Y, USING THE POWER SERIES FOR SMALL X, AND MPEXP FOR
     LARGE X.  SPACE = 5T+12 (OR 3T+8 FOR SMALL X).   CALLED BY MPERF.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.10
0  MPERF3
   ******
     CALL MPERF3 (X, Y, IND, ERROR)
0    TRYS TO RETURN
0          Y = EXP(X**2)*(INTEGRAL FROM X TO INFINITY OF EXP(-U**2)DU),
     OR
           Y = EXP(-X**2)*(INTEGRAL FROM 0 TO X OF EXP(U**2) DU),
0    FOR  IND  ZERO  OR NONZERO RESPECTIVELY, IN BOTH CASES USING THE ASYMPTOTIC
     SERIES.  X AND Y ARE MP NUMBERS, IND AND  ERROR  ARE  INTEGERS.   ERROR  IS
     RETURNED  AS  0 IF X IS LARGE ENOUGH FOR THE ASYMPTOTIC SERIES TO GIVE FULL
     ACCURACY, OTHERWISE ERROR IS RETURNED AS 1 AND Y AS ZERO.  THE CONDITION ON
     X FOR ERROR .EQ. 0 IS APPROXIMATELY THAT
0          X .GT. SQRT(T*LN(B)).
0    SPACE = 4T+10. CALLED BY MPERF, MPERFC AND MPDAW.
0  MPERR
   *****
     CALL MPERR
0    THIS ROUTINE IS CALLED WHEN A FATAL ERROR  CONDITION  IS  ENCOUNTERED,  AND
     AFTER  A  MESSAGE HAS BEEN WRITTEN ON LOGICAL UNIT LUN.  AS SUPPLIED IN THE
     MP PACKAGE, MPERR WRITES A MESSAGE AND STOPS.  IT COULD BE MODIFIED TO GIVE
     A  TRACE-BACK  (E.G.  WITH  UNIVAC  1100  FORTRAN V THIS CAN BE OBTAINED BY
     REPLACING STOP BY RETURN 0).
0  MPEUL
   *****
     CALL MPEUL (G)  OR  G = CTM (3HEUL)
0    RETURNS  MP  G  =  EULERS  CONSTANT (GAMMA = 0.57721566...)  TO ALMOST FULL
     MULTIPLE-PRECISION ACCURACY.  THE METHOD WAS DISCOVERED BY EDWIN MC  MILLAN
     AND  RICHARD  BRENT,  AND  IS  FASTER  THAN  THE METHOD OF SWEENEY (USED IN
     EARLIER VERSIONS OF MPEUL).  TIME = O(T**2), SPACE = 5T+18.
0  MPEXP
   *****
     CALL MPEXP (X, Y)  OR  Y = EXP (X)
0    RETURNS  Y = EXP(X) FOR MP X AND Y.  EXP OF INTEGER AND FRACTIONAL PARTS OF
     X  ARE  COMPUTED  SEPARATELY.   SEE  ALSO  COMMENTS  IN  MPEXP1.   TIME   =
     O(SQRT(T)M(T)), SPACE = 4T+10.
0  MPEXPA
   ******
     I = MPEXPA (X)  OR  I = EXPON (X)
0    RETURNS THE EXPONENT OF THE MP NUMBER X (OR LARGEST NEGATIVE EXPONENT IF  X
     IS ZERO).
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.11
0  MPEXPB
   ******
     CALL MPEXPB (I, X)  OR  EXPON (X) = I
0    SETS  EXPONENT  OF  MP  NUMBER  X  TO  I UNLESS X IS ZERO (WHEN EXPONENT IS
     UNCHANGED).  X MUST BE A VALID MP NUMBER (EITHER ZERO OR NORMALIZED).
0  MPEXP1
   ******
     CALL MPEXP1 (X, Y)  OR  Y = EXP1 (X)
0    RETURNS
           Y = EXP(X) - 1
0    WHERE  X  AND  Y  ARE  MP  NUMBERS  AND    -1  .LT.  X  .LT.  1.   USES  AN
     O(SQRT(T).M(T))   ALGORITHM   DESCRIBED   IN   -    THE    COMPLEXITY    OF
     MULTIPLE-PRECISION   ARITHMETIC   (BY   R.  P.  BRENT),  IN  COMPLEXITY  OF
     COMPUTATIONAL PROBLEM SOLVING, UNIV. OF QUEENSLAND PRESS,  BRISBANE,  1976,
     126-165.   ASYMPTOTICALLY FASTER METHODS EXIST, BUT ARE NOT USEFUL UNLESS T
     IS VERY LARGE (SEE COMMENTS ON MPATAN AND MPPIGL).  SPACE = 3T+8.
0  MPEXT
   *****
     CALL MPEXT (I, J, X)
0    ROUTINE  CALLED  BY MPDIV AND MPSQRT TO ENSURE THAT RESULTS ARE REPRESENTED
     EXACTLY IN T-2 DIGITS IF THEY CAN BE.  X IS AN  MP  NUMBER,  I  AND  J  ARE
     INTEGERS.  NOT RECOMMENDED FOR INDEPENDENT USE.
0  MPGAM
   *****
     CALL MPGAM (X, Y)  OR  Y = GAM (X)
0    COMPUTES MP Y = GAMMA(X) FOR MP ARGUMENT X, USING MPGAMQ IF ABS(X) .LE. 100
     AND  240*X  IS  AN  INTEGER, OTHERWISE USING MPLNGM.  SPACE REQUIRED IS THE
     SAME AS FOR MPLNGM (THOUGH ONLY 9T+20 IF MPGAMQ IS USED).  TIME =  O(T**3).
0  MPGAMQ
   ******
     CALL MPGAMQ (I, J, X)  OR  Y = GAMQ (I, J)  OR  Y = GAM (I, J)
0    RETURNS
           X = GAMMA (I/J),
0    WHERE  X  IS  MULTIPLE-PRECISION  AND I, J ARE SMALL INTEGERS.   THE METHOD
     USED IS REDUCTION OF THE ARGUMENT TO (0, 1) AND THEN A DIRECT EXPANSION  OF
     THE  DEFINING  INTEGRAL  TRUNCATED  AT  A SUFFICIENTLY HIGH LIMIT, USING 2T
     DIGITS TO COMPENSATE FOR CANCELLATION.  TIME = O(T**2) IF I/J  IS  NOT  TOO
     LARGE.  IF I/J .GT. 100 (APPROXIMATELY) IT IS FASTER TO USE MPGAM.  (MPGAMQ
     IS VERY SLOW IF I/J IS  VERY  LARGE,  BECAUSE  THE  RELATION  GAMMA(X+1)  =
     X*GAMMA(X)  IS  USED REPEATEDLY.)  IF I OR J IS TOO LARGE, INTEGER OVERFLOW
     WILL OCCUR, AND THE RESULT WILL BE INCORRECT.  THIS WILL USUALLY  (BUT  NOT
     ALWAYS) BE DETECTED AND AN ERROR MESSAGE GIVEN.  SPACE = 6T+12.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.12
0  MPGCD
   *****
     CALL MPGCD (K, L)
0    RETURNS  K  = K/GCD AND L = L/GCD, WHERE GCD IS THE GREATEST COMMON DIVISOR
     OF INITIAL K AND L (SINGLE-PRECISION INTEGERS).
0  MPGCDA
   ******
     CALL MPGCDA (X, Y, Z)  OR  Z = GCD (X, Y)
0    RETURNS  Z = GREATEST COMMON DIVISOR OF X AND Y.  GCD (X, 0) = GCD (0, X) =
     ABS(X), GCD (X, Y) .GE. 0.  X, Y AND  Z  ARE  INTEGERS  REPRESENTED  AS  MP
     NUMBERS,  AND  MUST  SATISFY  ABS(X)  .LT.  B**T, ABS(Y) .LT. B**T.  TIME =
     O(T**2), SPACE = 4T+10.
0  MPGCDB
   ******
     CALL MPGCDB (X, Y)
0    RETURNS  (X,  Y) AS (X/Z, Y/Z) WHERE Z IS THE GCD OF INITIAL X AND Y, WHICH
     ARE INTEGERS REPRESENTED AS MP NUMBERS, AND MUST SATISFY ABS(X) .LT.  B**T,
     ABS(Y) .LT. B**T.  TIME = O(T**2), SPACE = 5T+12.
0  MPGE
   ****
     LV = MPGE (X, Y))  OR  LV = (X .GE. Y)  OR  IF (X .GE. Y) ...
0    RETURNS LOGICAL VALUE OF (X .GE. Y) FOR MP X AND Y.  MPGE MUST BE  DECLARED
     LOGICAL UNLESS AUGMENT INTERFACE IS USED.
0  MPGT
   ****
     LV = MPGT (X, Y))  OR  LV = (X .GT. Y)  OR  IF (X .GT. Y) ...
0    RETURNS LOGICAL VALUE OF (X .GT. Y) FOR MP X AND Y.  MPGT MUST BE  DECLARED
     LOGICAL UNLESS AUGMENT INTERFACE IS USED.
0  MPHANK
   ******
     CALL MPHANK (X, NU, Y, ERROR)
0    TRIES TO COMPUTE THE BESSEL FUNCTION J (NU,  X)  USING  HANKELS  ASYMPTOTIC
     SERIES.  NU IS A NONNEGATIVE INTEGER .LE. MAX (B, 64), ERROR IS AN INTEGER.
     RETURNS ERROR = 0 IF SUCCESSFUL (RESULT J (NU, X) IN Y),
             ERROR = 1 IF UNSUCCESSFUL (Y UNCHANGED).
     ROUNDING ERROR COULD BE INDUCED BY O(B**(1-T)) PERTURBATIONS IN  X  AND  Y.
     TIME  =  O(T**3),  SPACE  =  11T+24.  CALLED BY MPBESJ, NOT RECOMMENDED FOR
     INDEPENDENT USE.
0  MPIN
   ****
     CALL MPIN (C, X, N, ERROR)
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.13
0    CONVERTS THE FIXED-POINT DECIMAL NUMBER (READ UNDER NA1 FORMAT) IN C(1) ...
     C(N)  TO  AN  MP  NUMBER  IN  X.   IF C REPRESENTS A VALID NUMBER, ERROR IS
     RETURNED AS 0.  IF C DOES NOT REPRESENT A VALID NUMBER, ERROR  IS  RETURNED
     AS  1  AND  X  AS  ZERO.  LEADING AND TRAILING BLANKS ARE ALLOWED, EMBEDDED
     BLANKS (EXCEPT BETWEEN THE NUMBER AND ITS SIGN) ARE FORBIDDEN.  IF THERE IS
     NO  DECIMAL  POINT  ONE  IS  ASSUMED  TO  LIE JUST TO THE RIGHT OF THE LAST
     DECIMAL DIGIT.  X IS AN  MP  NUMBER,  C  AN  INTEGER  ARRAY,  N  AND  ERROR
     INTEGERS.  SPACE = 3T+11.
0  MPINE
   *****
     CALL MPINE (C, X, N, J, ERROR)
0    SAME AS MPIN EXCEPT THAT THE RESULT (X) IS MULTIPLIED BY 10**J, WHERE J  IS
     A  SINGLE-PRECISION INTEGER.  FOR DETAILS OF THE OTHER ARGUMENTS, SEE MPIN.
     USEFUL FOR FLOATING-POINT INPUT OF MP  NUMBERS.   THE  USER  CAN  READ  THE
     EXPONENT  INTO J (USING ANY SUITABLE FORMAT) AND THE FRACTION INTO C (USING
     A1 FORMAT), THEN CALL MPINE TO  CONVERT  TO  MULTIPLE-PRECISION.   SPACE  =
     5T+12.
0  MPINF
   *****
     CALL MPINF (X, N, UNIT, IF ORM, ERR) OR  ERR = MPINF (X, N, UNIT, IFORM)
                                          OR  IF (MPINF (X, N, UNIT, IFORM)) ...
0    READS  N  WORDS  FROM  LOGICAL  UNIT IABS(UNIT) USING FORMAT IN IFORM, THEN
     CONVERTS TO MP NUMBER X USING ROUTINE MPIN.  IFORM SHOULD CONTAIN A  FORMAT
     WHICH ALLOWS FOR READING N WORDS IN A1 FORMAT, E.G. 6H(80A1).
     ERR  RETURNED  AS TRUE IF MPIN COULD NOT INTERPRET INPUT AS AN MP NUMBER OR
     IF N NOT POSITIVE, OTHERWISE FALSE.  IF ERR IS TRUE THEN X IS  RETURNED  AS
     ZERO.  SPACE REQUIRED 3T+N+11.
0  MPINIT
   ******
     CALL MPINIT (I)  OR  INITIALIZE MP
0    DECLARES BLANK COMMON (USED BY MP PACKAGE) AND CALLS  MPSET  TO  INITIALIZE
     PARAMETERS.  I IS A DUMMY INTEGER ARGUMENT.  THE AUGMENT DECLARATION
           INITIALIZE MP
     CAUSES A CALL TO MPINIT TO BE GENERATED.
0    WARNING  AS DISTRIBUTED MPINIT ASSUMES OUTPUT UNIT 6, 43 DECIMAL PLACES, 10
     *******  MP DIGITS, MXR = 296.   IF THE AUGMENT DESCRIPTION DECK IS CHANGED
     THIS ROUTINE SHOULD BE CHANGED ACCORDINGLY (SEE SECTION 5).
0  MPIO
   ****
     CALL MPIO (C, N, UNIT, IFORM, ERR)
0    IF  UNIT .GT. 0  WRITES C(1), ... , C(N) IN FORMAT IFORM,
     IF  UNIT .LE. 0  READS  C(1), ... , C(N) IN FORMAT IFORM,
     IN  BOTH  CASES  USES  LOGICAL  UNIT  IABS(UNIT).  C IS AN INTEGER ARRAY OF
     DIMENSION AT LEAST N.  ERR IS RETURNED AS FALSE IFF N POSITIVE.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.14
0  MPKSTR
   ******
     CALL MPKSTR (X, Y)  OR  Y = X
0    SETS Y = X FOR PACKED MP NUMBERS X AND Y.  ASSUMES SAME  PACKED  FORMAT  AS
     MPPACK AND MPUNPK, I.E. TYPE MULTIPAK FOR AUGMENT USERS.
0  MPLE
   ****
     LV = MPLE (X, Y))  OR  LV = (X .LE. Y)  OR  IF (X .LE. Y) ...
0    RETURNS LOGICAL VALUE OF (X .LE. Y) FOR MP X AND Y.  MPLE MUST BE  DECLARED
     TYPE LOGICAL UNLESS AUGMENT INTERFACE USED.
0  MPLI
   ****
     CALL MPLI (X, Y)  OR  Y = LI (X)
0    RETURNS
           Y = LI(X) = LOGARITHMIC INTEGRAL OF X
             = (PRINCIPAL VALUE INTEGRAL FROM 0 TO X OF DU/LN(U)),
0    USING  MPEI.  X AND Y ARE MP NUMBERS, X .GE. 0, X .NE. 1.  ERROR IN Y COULD
     BE INDUCED BY AN O(B**(1-T)) RELATIVE PERTURBATION IN X FOLLOWED BY SIMILAR
     PERTURBATION  IN Y.  THUS RELATIVE ERROR IN Y IS SMALL UNLESS X IS CLOSE TO
     1 OR TO THE ZERO 1.45136923488338105028...  OF  LI(X).   TIME  =  O(M(T)T),
     SPACE = 10T+38.
0  MPLN
   ****
     CALL MPLN (X, Y)  OR  Y = LN (X)  OR  Y = LOG (X)
0    RETURNS Y = LN(X), FOR MP X AND Y, USING MPLNS.  THE INTEGER PART OF  LN(X)
     MUST   BE   REPRESENTABLE   AS   A   SINGLE-PRECISION   INTEGER.    TIME  =
     O(SQRT(T)M(T)).  FOR SMALL INTEGER  X,  MPLNI  IS  FASTER.   ASYMPTOTICALLY
     FASTER  METHODS  EXIST (E.G. THE GAUSS-SALAMIN METHOD, SEE MPLNGS), BUT ARE
     NOT USEFUL UNLESS T IS LARGE.  SEE COMMENTS ON MPATAN, MPEXP1  AND  MPPIGL.
     SPACE = 6T+14.
0  MPLNGM
   ******
     CALL MPLNGM (X, Y)  OR  Y = LNGM (X)
0    RETURNS MP Y = LN(GAMMA(X)) FOR POSITIVE MP X, USING  STIRLINGS  ASYMPTOTIC
     APPROXIMATION.  SLOWER THAN MPGAMQ (UNLESS X LARGE) AND USES MORE SPACE, SO
     USE MPGAMQ AND MPLN IF X IS RATIONAL AND NOT TOO LARGE,  SAY  X  LESS  THAN
     100.  TIME = O(T**3).  SPACE = 11T+24+NL*((T+3)/2),  WHERE NL IS THE NUMBER
     OF TERMS USED IN THE ASYMPTOTIC EXPANSION,  NL .LE. 2+0.125*T*LN(B).
0    MPLNGM, MPGAM AND MPBESJ REQUIRE MORE SPACE THAN ANY OTHER MP ROUTINES.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.15
0  MPLNGS
   ******
     CALL MPLNGS (X, Y)  OR  Y = LNGS (X)
0    RETURNS  Y  = LN(X) FOR MP X AND Y, USING THE GAUSS-SALAMIN ALGORITHM BASED
     ON THE ARITHMETIC-GEOMETRIC MEAN ITERATION (SEE  -  ANALYTIC  COMPUTATIONAL
     COMPLEXITY (ED. BY J. F. TRAUB), ACADEMIC PRESS, 1976, 151-176) UNLESS X IS
     CLOSE TO 1.  SPACE = 6T+26, TIME = O(LOG(T)M(T)) + O(T**2) IF ABS(X-1) .GE.
     1/B  AND  AS  FOR  MPLNS  OTHERWISE.   SLOWER  THAN  MPLN UNLESS T IS LARGE
     (GREATER THAN ABOUT 500) SO RECOMMENDED FOR TESTING PURPOSES ONLY.
0  MPLNI
   *****
     CALL MPLNI (N, X)  OR  X = LNI (N)
                        OR  X = LN (N)  OR  X = LOG (N)
0    RETURNS MP X =  LN(N)  FOR  SMALL  POSITIVE  INTEGER  N,  USING  A  RAPIDLY
     CONVERGING SERIES AND MPL235.  TIME = O(T**2), SPACE = 3T+8.
0  MPLNS
   *****
     CALL MPLNS (X, Y)  OR  Y = LNS (X)
0    RETURNS MP Y = LN(1+X) IF X IS AN MP NUMBER SATISFYING THE CONDITION
           ABS(X) .LT. 1/B,
     ERROR  OTHERWISE.   USES NEWTONS METHOD TO SOLVE THE EQUATION EXP1(-Y) = X,
     THEN REVERSES SIGN OF Y.  (HERE EXP1(Y) = EXP(Y)  -  1  IS  COMPUTED  USING
     MPEXP1).  TIME = O(SQRT(T).M(T)), SPACE = 5T+12.
0  MPLT
   ****
     LV = MPLT (X, Y))  OR  LV = (X .LT. Y)  OR  IF (X .LT. Y) ...
0    RETURNS LOGICAL VALUE OF (X .LT. Y) FOR MP X AND Y.  MPLT MUST BE  DECLARED
     TYPE LOGICAL UNLESS AUGMENT INTERFACE USED.
0  MPL235
   ******
     CALL MPL235 (I, J, K, X)
0    RETURNS
           X = LN((2**I)*(3**J)*(5**K)),
     FOR  MP  X  AND INTEGER I, J AND K.  LN(81/80), LN(25/24) AND LN(16/15) ARE
     CALCULATED FIRST.  (MPL235 COULD BE SPEEDED  UP  IF  THESE  CONSTANTS  WERE
     PRECOMPUTED  AND  SAVED.)   ASSUMED  THAT  I,  J  AND  K NOT TOO LARGE (SEE
     COMMENTS IN SOURCE).  TIME = O(T**2), SPACE = 3T+8.  CALLED BY  MPLNI,  NOT
     RECOMMENDED FOR INDEPENDENT USE.
0  MPMAX
   *****
     CALL MPMAX (X, Y, Z)  OR  Z = MAX (X, Y)
0    SETS Z = MAX (X, Y) WHERE X, Y AND Z ARE MULTIPLE-PRECISION.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.16
0  MPMAXR
   ******
     CALL MPMAXR (X)  OR  X = CTM (4HMAXR)
0    SETS X TO THE LARGEST POSSIBLE POSITIVE MP NUMBER.
0  MPMEXA
   ******
     I = MPMEXA (X)  OR  I = MAXEXP (X)
0    RETURNS  THE  MAXIMUM  ALLOWABLE  EXPONENT OF MP NUMBERS (THE THIRD WORD OF
     COMMON).  X IS A DUMMY MP ARGUMENT (AUGMENT EXPECTS ONE).
0  MPMEXB
   ******
     CALL MPMEXB (I, X)  OR  MAXEXP (X) = I
0    SETS  THE  MAXIMUM ALLOWABLE EXPONENT OF MP NUMBERS (I.E. THE THIRD WORD OF
     COMMON) TO I.  I SHOULD BE GREATER THAN T, AND 4*I SHOULD BE  REPRESENTABLE
     AS A SINGLE-PRECISION INTEGER.  X IS A DUMMY MP ARGUMENT.
0  MPMIN
   *****
     CALL MPMIN (X, Y, Z)  OR  Z = MIN (X, Y)
0    SETS Z = MIN (X, Y) WHERE X, Y AND Z ARE MULTIPLE-PRECISION.
0  MPMINR
   ******
     CALL MPMINR (X)  OR  X = CTM (4HMINR)
0    SETS X TO THE SMALLEST POSITIVE NORMALIZED MP NUMBER.
0  MPMLP
   *****
     CALL MPMLP (U, V, W, J)
0    PERFORMS INNER MULTIPLICATION LOOP FOR MPMUL.  CARRIES ARE  NOT  PROPAGATED
     IN INNER LOOP, WHICH SAVES TIME AT THE EXPENSE OF SPACE.
0  MPMUL
   *****
     CALL MPMUL (X, Y, Z)  OR  Z = X*Y
0    MULTIPLIES X AND Y, RETURNING RESULT IN Z, FOR MP X, Y AND Z.   THE  SIMPLE
     O(T**2)  ALGORITHM  IS  USED,  WITH  FOUR  GUARD  DIGITS  AND  R*-ROUNDING.
     ADVANTAGE IS TAKEN OF ZERO DIGITS IN  X,  BUT  NOT  IN  Y.   ASYMPTOTICALLY
     FASTER  ALGORITHMS  ARE  KNOWN  (SEE  KNUTH,  VOL. 2), BUT ARE DIFFICULT TO
     IMPLEMENT IN FORTRAN IN AN EFFICIENT AND MACHINE-INDEPENDENT MANNER.
0    IN  COMMENTS  ON  OTHER MP ROUTINES, M(T) IS THE TIME TO PERFORM T-DIGIT MP
     MULTIPLICATION.   THUS M(T) = O(T**2) WITH THE PRESENT  VERSION  OF  MPMUL,
     BUT M(T) = O(T.LOG(T).LOG(LOG(T))) IS THEORETICALLY POSSIBLE.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.17
0  MPMULI
   ******
     CALL MPMULI (X, IY, Z)  OR  Z = X*IY
0    MULTIPLIES  MP  X BY SINGLE-PRECISION INTEGER IY GIVING MP Z.  TIME = O(T),
     WHICH IS FASTER THAN MPMUL.  RESULT IS ROUNDED.  MULTIPLICATION BY 1 MAY BE
     USED TO NORMALIZE A NUMBER EVEN IF THE LAST DIGIT IS B.
     AUGMENT USERS -  Z = X*IY IS FASTER THAN Z = IY*X.
0  MPMULQ
   ******
     CALL MPMULQ (X, I, J, Y)  OR  Y = MULQ (X, I, J)
0    MULTIPLIES MP X BY I/J, GIVING MP Y.   HERE I AND  J  ARE  SINGLE-PRECISION
     INTEGERS, J. NE. 0 . TIME = O(T).
     AUGMENT USERS -  Y = MULQ (X, I, J) IS USUALLY FASTER THAN
                      Y = X * CTM (I,J).
0  MPMUL2
   ******
     CALL MPMUL2 (X, IY, Z, TRUNC)
0    MULTIPLIES MP X BY SINGLE-PRECISION INTEGER IY GIVING MP Z.  MULTIPLICATION
     BY 1 MAY BE USED TO NORMALIZE A NUMBER EVEN IF SOME DIGITS ARE GREATER THAN
     B-1.   RESULT  IS  ROUNDED IF (INTEGER) TRUNC IS ZERO, OTHERWISE TRUNCATED.
     CALLED BY MPMULI, NOT RECOMMENDED FOR INDEPENDENT USE.
0  MPNE
   ****
     LV = MPNE (X, Y))  OR  LV = (X .NE. Y)  OR  IF (X .NE. Y) ...
0    RETURNS  LOGICAL VALUE OF (X .NE. Y) FOR MP X AND Y.  MPNE MUST BE DECLARED
     TYPE LOGICAL UNLESS AUGMENT INTERFACE USED.
0  MPNEG
   *****
     CALL MPNEG (X, Y)  OR  Y = -X
0    SETS Y = -X FOR MP NUMBERS X AND Y.
0  MPNZR
   *****
     CALL MPNZR (RS, RE, Z, TRUNC)
0    ASSUMES LONG (I.E. (T+4)-DIGIT) FRACTION IN R, SIGN = RS,  EXPONENT  =  RE.
     NORMALIZES,  AND  RETURNS  MP RESULT IN Z.  INTEGER ARGUMENTS RS AND RE ARE
     NOT PRESERVED.  R*-ROUNDING IS USED IF (INTEGER) TRUNC IS  ZERO,  OTHERWISE
     RESULT  IS  TRUNCATED.   CALLED BY MPADD2, MPDIVI, MPMUL, MPMUL2, ETC., AND
     NOT RECOMMENDED FOR INDEPENDENT USE.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.18
0  MPOUT
   *****
     CALL MPOUT (X, C, P, N)
0    CONVERTS MP X TO FP.N FORMAT IN C, WHICH MAY BE PRINTED UNDER  PA1  FORMAT.
     NOTE THAT N = -1 IS ALLOWED, AND EFFECTIVELY GIVES IP FORMAT.  DIGITS AFTER
     THE DECIMAL POINT ARE  BLANKED  OUT  IF  THEY  COULD  NOT  BE  SIGNIFICANT.
     EFFICIENCY  IS  HIGHER  IF  B  IS  A  POWER OF 10 THAN IF NOT.  P AND N ARE
     INTEGERS, C IS AN INTEGER ARRAY OF DIMENSION AT LEAST P.  TIME  =  O(T**2),
     SPACE = 3T+11.
0  MPOUTE
   ******
     CALL MPOUTE (X, C, J, P)
0    ASSUMES X IS AN MP NUMBER AND C AN INTEGER ARRAY OF DIMENSION  AT  LEAST  P
     .GE. 4.  ON RETURN J IS THE EXPONENT (TO BASE TEN) OF X AND THE FRACTION IS
     IN C, READY TO BE PRINTED IN A1 FORMAT.  FOR EXAMPLE, WE COULD PRINT J  AND
     C  IN  (I10,  1X,  PA1)  FORMAT.  THE FRACTION HAS ONE PLACE BEFORE DECIMAL
     POINT AND P-3 AFTER.  J AND P ARE INTEGERS.    SPACE = 6T+14.
0  MPOUTF
   ******
     CALL MPOUTF (X, P, N, IFORM, ERR)  OR  ERR = MPOUTF (X, P, N, IFORM)
                                        OR  IF (MPOUTF (X, P, N, IFORM)) ...
0    WRITES MP NUMBER X ON LOGICAL UNIT LUN (FOURTH WORD OF  COMMON)  IN  FORMAT
     IFORM  AFTER CONVERTING TO FP.N DECIMAL REPRESENTATION USING ROUTINE MPOUT.
     FOR FURTHER DETAILS SEE COMMENTS ON MPOUT.  IFORM SHOULD CONTAIN  A  FORMAT
     WHICH ALLOWS FOR OUTPUT OF P WORDS IN A1 FORMAT, PLUS ANY DESIRED HEADINGS,
     SPACING ETC., FOR EXAMPLE
           24H(8H1HEADING/(11X,100A1)) .
     ERR IS RETURNED AS FALSE IFF P IS POSITIVE.  SPACE = 3T+P+11.
0  MPOUT2
   ******
     CALL MPOUT2 (X, C, P, N, NB)
0    SAME AS MPOUT EXCEPT THAT OUTPUT REPRESENTATION IS IN BASE NB, WHERE 2 .LE.
     NB  .LE.  16,  E.G.  NB  = 8 GIVES OCTAL OUTPUT, NB = 16 GIVES HEXADECIMAL.
     OUTPUT DIGITS ARE 0123456789ABCDEF.  X IS AN MP NUMBER,  P, N  AND  NB  ARE
     INTEGERS,  C  IS AN INTEGER ARRAY OF DIMENSION AT LEAST P.  TIME = O(T**2),
     SPACE = 3T+11.  CALLED BY MPOUT.
0  MPOVFL
   ******
     CALL MPOVFL (X)
0    CALLED  ON MULTIPLE-PRECISION OVERFLOW, THAT IS WHEN THE EXPONENT OF THE MP
     NUMBER X WOULD EXCEED M.  AT PRESENT EXECUTION IS TERMINATED WITH AN  ERROR
     MESSAGE  AFTER  CALLING  MPMAXR(X),  BUT  IT  WOULD  BE POSSIBLE TO RETURN,
     POSSIBLY UPDATING A COUNTER AND TERMINATING EXECUTION AFTER A PRESET NUMBER
     OF OVERFLOWS.  (ACTION COULD BE DETERMINED BY A FLAG IN LABELLED COMMON.)
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.19
0  MPPACK
   ******
     CALL MPPACK (X, Y)  OR  Y = X  OR  Y = CTP (X)
0    ASSUMES  THAT X IS AN MP NUMBER REPRESENTED AS USUAL IN AN INTEGER ARRAY OF
     DIMENSION AT LEAST T+2, AND Y IS AN INTEGER ARRAY  OF  DIMENSION  AT  LEAST
     INT((T+3)/2).   X  IS STORED IN A COMPACT FORMAT IN Y, AND MAY BE RETRIEVED
     BY CALLING MPUNPK (Y, X).   MPPACK  AND  MPUNPK  ARE  USEFUL  IF  SPACE  IS
     CRITICAL, FOR EXAMPLE WHEN WORKING WITH LARGE ARRAYS OF MP NUMBERS.
     AUGMENT USERS -  X IS TYPE MULTIPLE, Y IS TYPE MULTIPAK.
0  MPPI
   ****
     CALL MPPI (X)  OR  X = CTM (2HPI)
0    SETS MP X = PI TO THE AVAILABLE PRECISION.  USES THE FORMULA OF MACHIN  AND
     CALLS MPART1.  TIME = O(T**2), SPACE = 3T+8.
0  MPPIGL
   ******
     CALL MPPIGL (PI)
0    SETS  MP  PI  =  3.14159...  TO  THE   AVAILABLE   PRECISION.    USES   THE
     GAUSS-LEGENDRE ALGORITHM.  THIS METHOD REQUIRES TIME O(LN(T)M(T)), SO IT IS
     SLOWER THAN MPPI IF M(T) = O(T**2), BUT WOULD BE FASTER FOR LARGE  T  IF  A
     FASTER  MULTIPLICATION  ALGORITHM WERE USED (SEE COMMENTS ON MPMUL).  FOR A
     DESCRIPTION OF THE METHOD, SEE - MP  ZERO-FINDING  AND  THE  COMPLEXITY  OF
     ELEMENTARY  FUNCTION EVALUATION (BY R. P. BRENT), IN ANALYTIC COMPUTATIONAL
     COMPLEXITY (EDITED BY J. F. TRAUB), ACADEMIC PRESS, 1976, 151-176.  SPACE =
     6T+14.  RECOMMENDED MAINLY FOR TESTING PURPOSES.
0  MPPOLY
   ******
     CALL MPPOLY (X, Y, IC, N)
0    SETS Y = IC(1) + IC(2)*X + ... + IC(N)*X**(N-1),  WHERE  X  AND  Y  ARE  MP
     NUMBERS  AND  IC  IS AN INTEGER ARRAY OF DIMENSION AT LEAST N (GREATER THAN
     ZERO).  SPACE = 3T+8 (BUT Y(1) MAY BE R(2T+7)).
0  MPPWR
   *****
     CALL MPPWR (X, N, Y)  OR  Y = X**N
0    RETURNS  Y = X**N, FOR MP X AND Y, INTEGER N, WITH 0**0 = 1.  SPACE = 4T+10
     (2T+6 IS ENOUGH IF N NONNEGATIVE).
0  MPPWR2
   ******
     CALL MPPWR2 (X, Y, Z)  OR  Z = X**Y
0    RETURNS  Z  = X**Y FOR MP NUMBERS X, Y AND Z, WHERE X IS POSITIVE (X .EQ. 0
     ALLOWED IF Y .GT. 0).  SLOWER  THAN  MPPWR  AND  MPQPWR,  SO  USE  THEM  IF
     POSSIBLE.  SPACE = 7T+16.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.20
0  MPQPWR
   ******
     CALL MPQPWR (I, J, K, L, X)  OR  X = QPWR (I, J, K, L)
0    SETS MP X = (I/J)**(K/L) FOR INTEGERS I, J, K AND L.  USES MPROOT IF ABS(L)
     SMALL, OTHERWISE USES MPLNI AND MPEXP.  SPACE = 4T+10.
     AUGMENT USERS -  X = QPWR (I,J,K,L) IS USUALLY FASTER THAN
                      X = CTM(I,J)**CTM(K,L).
0  MPREC
   *****
     CALL MPREC (X, Y)  OR  Y = REC (X)
0    RETURNS Y = 1/X, FOR MP X  AND  Y.   SPACE  =  4T+10.   (BUT  Y(1)  MAY  BE
     R(3T+9)).   NEWTONS  METHOD  IS USED, SO FINAL ONE OR TWO DIGITS MAY NOT BE
     CORRECT.  CALLED BY MPDIV.
     AUGMENT USERS -  Y = REC(X) IS FASTER THAN Y = 1/X.
0  MPROOT
   ******
     CALL MPROOT (X, N, Y)  OR  Y = ROOT (X, N)
0    RETURNS  Y  =  X**(1/N)  FOR  INTEGER  N,  ABS(N) .LE. MAX (B, 64).  AND MP
     NUMBERS X AND Y, USING NEWTONS METHOD WITHOUT DIVISIONS.    SPACE  =  4T+10
     (BUT Y(1) MAY BE R(3T+9)).
     AUGMENT USERS -  Y = ROOT (X, N) IS FASTER THAN Y = X**CTM(1,N)
                      (AND Y = X**(1/N) IS INCORRECT AS 1/N IS USUALLY ZERO).
0  MPSET
   *****
     CALL MPSET (LUNIT, IDECPL, ITMAX2, MAXDR)
0    SETS  BASE  (B) AND NUMBER OF DIGITS (T) TO GIVE THE EQUIVALENT OF AT LEAST
     IDECPL DECIMAL DIGITS.  IDECPL SHOULD BE POSITIVE.  ITMAX2 IS THE DIMENSION
     OF ARRAYS USED FOR MP NUMBERS, SO AN ERROR OCCURS IF THE COMPUTED T EXCEEDS
     ITMAX2 - 2.  MPSET ALSO SETS
0          LUN = LUNIT (LOGICAL UNIT FOR ERROR MESSAGES),
           MXR = MAXDR (DIMENSION OF R IN COMMON, .GE. T+4), AND
           M = (W-1)/4 (MAXIMUM ALLOWABLE EXPONENT),
0    WHERE W IS THE LARGEST INTEGER OF THE FORM 2**K-1 WHICH IS REPRESENTABLE IN
     THE  MACHINE,   K .LE. 47.  (USUALLY K+1 = THE NUMBER OF BITS PER WORD, BUT
     THIS IS NOT TRUE ON CDC 6000/7000 MACHINES.)  THE COMPUTED B AND T  SATISFY
     (T-1)*LN(B)/LN(10) .GE. IDECPL   AND   8*B*B-1 .LE. W .
     APPROXIMATELY  MINIMAL  T  AND  MAXIMAL  B  SATISFYING THESE CONDITIONS ARE
     CHOSEN.  PARAMETERS LUNIT, IDECPL, ITMAX2 AND MAXDR ARE INTEGERS.
0    WARNING  MPSET  WILL  CAUSE   AN INTEGER OVERFLOW TO OCCUR IF WORDLENGTH IS
     *******   LESS  THAN  48  BITS.   IF  THIS  IS  NOT  ALLOWABLE,  CHANGE THE
     DETERMINATION OF W (DO 30 ... TO 30 W = WN) OR SET B, T,  M,  LUN  AND  MXR
     WITHOUT CALLING MPSET.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.21
0  MPSIGA
   ******
     I = MPSIGA (X)  OR  I = SGN (X)
0    RETURNS SIGN OF MP NUMBER X.
0  MPSIGB
   ******
     CALL MPSIGB (I, X)  OR  SGN (X) = I
0    SETS SIGN OF MP NUMBER X TO I.  I SHOULD BE 0,  +1  OR  -1.   EXPONENT  AND
     DIGITS OF X ARE UNCHANGED, BUT RESULT MUST BE A VALID MP NUMBER.
0  MPSIN
   *****
     CALL MPSIN (X, Y)  OR  Y = SIN (X)
0    RETURNS Y = SIN(X) FOR MP X AND Y, METHOD IS TO REDUCE X TO (-1, 1) AND USE
     MPSIN1, SO TIME = O(M(T)T/LOG(T)).  SPACE = 5T+12.
0  MPSINH
   ******
     CALL MPSINH (X, Y)  OR  Y = SINH (X)
0    RETURNS Y = SINH(X) FOR MP NUMBERS X AND Y, X NOT TOO LARGE.  METHOD IS  TO
     USE MPEXP OR MPEXP1,  TIME = O(SQRT(T)M(T)),  SPACE = 5T+12.
0  MPSIN1
   ******
     CALL MPSIN1 (X, Y, IS)
0    RETURNS
           Y = SIN(X)  IF IS .NE .0,
           Y = COS(X)  IF IS .EQ .0,
     USING THE TAYLOR SERIES.  ASSUMES ABS(X) .LE. 1.
     X AND Y ARE MP NUMBERS, IS IS AN INTEGER.  TIME  =  O(M(T)T/LOG(T)).   THIS
     COULD  BE REDUCED TO O(SQRT(T)M(T)) AS IN MPEXP1, BUT NOT WORTHWHILE UNLESS
     T IS VERY LARGE.   ASYMPTOTICALLY  FASTER  METHODS  ARE  DESCRIBED  IN  THE
     REFERENCES  GIVEN  IN COMMENTS ON MPATAN AND MPPIGL.  SPACE = 3T+8.  CALLED
     BY MPCOS AND MPSIN AND NOT RECOMMENDED FOR INDEPENDENT USE.
0  MPSQRT
   ******
     CALL MPSQRT (X, Y)  OR  Y = SQRT (X)
0    RETURNS  Y  = SQRT(X) USING SUBROUTINE MPROOT.  SPACE = 4T+10 (BUT Y(1) MAY
     BE R(3T+9)).  X AND Y ARE MP NUMBERS,  X .GT. 0.
0  MPSTR
   *****
     CALL MPSTR (X, Y)  OR  Y = X
0    SETS Y = X FOR MP X AND Y.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.22
0  MPSUB
   *****
     CALL MPSUB (X, Y, Z)  OR  Z = X - Y
0    SUBTRACTS  Y  FROM  X,  FORMING RESULT IN Z, FOR MP X, Y AND Z.  FOUR GUARD
     DIGITS ARE USED, AND THEN R*-ROUNDING (SEE MPADD2).
0  MPTAN
   *****
     CALL MPTAN (X, Y)  OR  Y = TAN (X)
0    SETS  Y  =  TAN(X)  FOR  MP  X  AND  Y.   USES  SUBROUTINE MPSIN1 SO TIME =
     O(M(T)T/LOG(T)).  SPACE = 6T+20.
0  MPTANH
   ******
     CALL MPTANH (X, Y)  OR  Y = TANH (X)
0    RETURNS  Y = TANH(X) FOR MP NUMBERS X AND Y, USING MPEXP OR MPEXP1.  TIME =
     O(SQRT(T)M(T)),  SPACE = 5T+12.
0  MPUNFL
   ******
     CALL MPUNFL (X)
0    CALLED ON MULTIPLE-PRECISION UNDERFLOW, THAT IS WHEN THE EXPONENT OF THE MP
     NUMBER X WOULD BE LESS THAN -M.  THE UNDERFLOWING NUMBER IS  SET  TO  ZERO.
     AN ALTERNATIVE WOULD BE TO CALL MPMINR (X) AND/OR RETURN, POSSIBLY UPDATING
     A COUNTER AND TERMINATING EXECUTION AFTER A PRESET  NUMBER  OF  UNDERFLOWS.
     (ACTION COULD BE DETERMINED BY A FLAG IN LABELLED COMMON.)
0  MPUNPK
   ******
     CALL MPUNPK (Y, X)  OR  X = Y
0    RESTORES THE MP NUMBER X WHICH  IS  STORED  IN  COMPRESSED  FORMAT  IN  THE
     INTEGER ARRAY Y.  FOR FURTHER DETAILS SEE SUBROUTINE MPPACK.
     AUGMENT INTERFACE USERS - X IS TYPE MULTIPLE,
                               Y IS TYPE MULTIPAK.
0  MPUPK
   *****
     CALL MPUPK (SOURCE, DEST, LDEST, LFIELD)
0    THIS  SUBROUTINE  UNPACKS  A  PACKED  HOLLERITH STRING (SOURCE) PLACING ONE
     CHARACTER PER WORD IN THE  ARRAY  DEST  (AS  IF  READ  IN  A1  FORMAT).  IT
     CONTINUES  UNPACKING  UNTIL  IT  FINDS  A  SENTINEL ($) OR UNTIL IT FINDS A
     COMPILER GENERATED SENTINEL (IF SO IMPLEMENTED)  OR  UNTIL  IT  HAS  FILLED
     LDEST  WORDS  OF  THE  ARRAY  DEST.   THE  LENGTH OF THE UNPACKED STRING IS
     RETURNED IN LFIELD.   THUS 0 .LE. LFIELD .LE. LDEST.
0    WARNING  MACHINE DEPENDENT - SEE SECTION 5 AND COMMENTS IN SOURCE.
     *******
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.23
0  MPZETA
   ******
     CALL MPZETA (N, X)  OR  X = ZETA (N)
0    RETURNS  MP  X = ZETA(N) FOR INTEGER N .GT. 1, WHERE ZETA(N) IS THE RIEMANN
     ZETA FUNCTION (THE SUM FROM I =  1  TO  INFINITY  OF  I**(-N)).   USES  THE
     EULER-MACLAURIN  SERIES UNLESS N = 2, 4, 6 OR 8.  IN THE WORST CASE SPACE =
     8T+18+NL*((T+3)/2), WHERE NL IS THE NUMBER OF  TERMS  USED  IN  THE  EULER-
     MACLAURIN SERIES, NL .LE. 1 + 0.1*T*LN(B).  TIME = O(T**3).
0  MP40D
   *****
     CALL MP40D (N, X)
0    OUTPUT ROUTINE CALLED BY TEST PROGRAM, WRITES MP X TO N DECIMAL  PLACES  ON
     UNIT LUN, ASSUMING -10 .LT. X .LT. 100.  SPACE = 3T+N+14.
0  MP40E
   *****
     CALL MP40E (N, X)
0    WRITES X(1), ... , X(N) ON UNIT  LUN,  WHERE  X  IS  AN  INTEGER  ARRAY  OF
     DIMENSION AT LEAST N .GE. 1.  CALLED BY MP40D.
0  MP40F
   *****
     CALL MP40F (N, X)
0    OUTPUT ROUTINE CALLED BY TEST2 PROGRAM, WRITES X TO N  SIGNIFICANT  FIGURES
     ON UNIT LUN,  N .GE. 2.  SPACE = 6T+N+17.
0  MP40G
   *****
     CALL MP40G (N, X)
0    WRITES X(1), ... , X(N) ON UNIT  LUN,  WHERE  X  IS  AN  INTEGER  ARRAY  OF
     DIMENSION AT LEAST N .GE. 1.  CALLED BY MP40F.
0  TEST
   ****
0    THIS MAIN PROGRAM COMPUTES THE CONSTANTS GIVEN IN APPENDIX A OF KNUTH,  THE
     ART OF COMPUTER PROGRAMMING, VOL. 3.  THE CONSTANTS ARE PRINTED IN THE SAME
     ORDER AS THEY ARE GIVEN IN KNUTH.
0    THE  CONSTANTS  ARE  COMPUTED  TO  40  DECIMAL  PLACES, BUT TO INCREASE THE
     ACCURACY IT IS ONLY NECESSARY TO CHANGE THE  STATEMENT  IDECPL  =  40,  AND
     POSSIBLY  THE  PARAMETERS  OF  THE  CALL TO MPSET AND THE DIMENSIONS OF THE
     ARRAYS (SEE TESTV PROGRAM).
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.24
0    TO RUN TEST THE FOLLOWING MP ROUTINES ARE REQUIRED - MPABS, MPADD,  MPADDI,
     MPADDQ,  MPADD2, MPADD3, MPART1, MPCHK, MPCIM, MPCLR, MPCMF, MPCMI, MPCMPI,
     MPCMPR, MPCMR, MPCOMP, MPCOS, MPCQM, MPCRM, MPDIV,  MPDIVI,  MPERR,  MPEUL,
     MPEXP,  MPEXP1,  MPEXT,  MPGAMQ, MPGCD, MPLN, MPLNI, MPLNS, MPL235, MPMAXR,
     MPMLP, MPMUL, MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2,  MPOVFL,  MPPI,
     MPPWR,  MPQPWR,  MPREC, MPROOT, MPSET, MPSIN, MPSIN1, MPSQRT, MPSTR, MPSUB,
     MPUNFL, MP40D, AND MP40E.
0    CORRECT OUTPUT (EXCLUDING HEADINGS) IS AS FOLLOWS
0         1.4142135623 7309504880 1688724209 6980785697
          1.7320508075 6887729352 7446341505 8723669428
          2.2360679774 9978969640 9173668731 2762354406
          3.1622776601 6837933199 8893544432 7185337196
          1.2599210498 9487316476 7210607278 2283505703
          1.4422495703 0740838232 1638310780 1095883919
          1.1892071150 0272106671 7499970560 4759152930
          0.6931471805 5994530941 7232121458 1765680755
          1.0986122886 6810969139 5245236922 5257046475
          2.3025850929 9404568401 7991454684 3642076011
          1.4426950408 8896340735 9924681001 8921374266
          0.4342944819 0325182765 1128918916 6050822944
          3.1415926535 8979323846 2643383279 5028841972
          0.0174532925 1994329576 9236907684 8861271344
          0.3183098861 8379067153 7767526745 0287240689
          9.8696044010 8935861883 4490999876 1511353137
          1.7724538509 0551602729 8167483341 1451827975
          2.6789385347 0774763365 5692940974 6776441287
          1.3541179394 2640041694 5288028154 5137855193
          2.7182818284 5904523536 0287471352 6624977572
          0.3678794411 7144232159 5523770161 4608674458
          7.3890560989 3065022723 0427460575 0078131803
          0.5772156649 0153286060 6512090082 4024310422
          1.1447298858 4940017414 3427351353 0587116473
          1.6180339887 4989484820 4586834365 6381177203
          1.7810724179 9019798523 6504103107 1795491696
          2.1932800507 3801545655 9769659278 7382234616
          0.8414709848 0789650665 2502321630 2989996226
          0.5403023058 6813971740 0936607442 9766037323
          1.2020569031 5959428539 9738161511 4499907650
          0.4812118250 5960344749 7758913424 3684231352
          2.0780869212 3502753760 1322606117 7957677422
          0.3665129205 8166432701 2439158232 6694694543
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.25
0  TESTV
   *****
0    THIS MAIN PROGRAM (A VARIABLE  PRECISION  VERSION  OF  TEST)  COMPUTES  THE
     CONSTANTS  GIVEN  IN  APPENDIX A OF KNUTH, THE ART OF COMPUTER PROGRAMMING,
     VOL. 3.  THE CONSTANTS ARE PRINTED IN THE SAME ORDER AS THEY ARE  GIVEN  IN
     KNUTH.   THE CONSTANTS ARE GIVEN TO HIGH PRECISION IN - KNUTHS CONSTANTS TO
     1000 DECIMAL AND 1100 OCTAL PLACES (BY R. P. BRENT), ANU  COMPUTER  CENTRE,
     TECH. REPORT NUMBER 47, 1975 (UMT 30, MATH. COMP. 30 (1976), 668).
0    THE OUTPUT LOGICAL UNIT NUMBER AND THE NUMBER OF DECIMAL PLACES FOR WORKING
     AND  OUTPUT  ARE  READ  FROM UNIT 5 IN FORMAT (2I4).  WE ASSUME T .LE. 100,
     OTHERWISE THE DIMENSION STATEMENTS AND CALL TO MPSET MUST BE CHANGED.
0    SOME EXECUTION TIMES ARE
0    UNIVAC 1108 (FOR SE1D UNDER EXEC 8)
        40D       4.420 SECONDS
        60D       6.981
        80D      10.293
       100D      13.970
       200D      42.083
       400D     161.524
      1000D    1065.567
0    DEC KA10 (F10, NOOPT)
        40D      10.98  SECONDS
        60D      19.12
        80D      26.74
       100D      36.16
       200D     114.70
0    IBM 360/50 (FTN H, OPT = 2) (SLOWER VERSION OF MP THAN CURRENT ONE)
        40D      25.039 SECONDS
        60D      42.461
        80D      58.859
       100D      83.166
       200D     259.078
0    IBM 360/91 (FTN H EXTENDED, OPT = 2) (SLOWER VERSION)
        40D       2.20 SECONDS
0    IBM 370/168 (FTN H EXTENDED, OPT = 2) (SLOWER VERSION)
        40D       1.66 SECONDS
0    PDP 11/45 (DOS, NO FLOATING-POINT HARDWARE) (SLOWER VERSION)
        40D     128  SECONDS
        60D     226
        80D     370
       100D     548
0    CYBER 76 (FTN 4.2, OPT = 1) (SLOWER VERSION)
        40D       0.478 SECONDS
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE 6.26
0    TO RUN TESTV THE FOLLOWING MP ROUTINES ARE REQUIRED - MPABS, MPADD, MPADDI,
     MPADDQ,  MPADD2, MPADD3, MPART1, MPCHK, MPCIM, MPCLR, MPCMF, MPCMI, MPCMPI,
     MPCMPR, MPCMR, MPCOMP, MPCOS, MPCQM, MPCRM, MPDIV,  MPDIVI,  MPERR,  MPEUL,
     MPEXP,  MPEXP1,  MPEXT,  MPGAMQ, MPGCD, MPLN, MPLNI, MPLNS, MPL235, MPMAXR,
     MPMLP, MPMUL, MPMULI, MPMULQ, MPMUL2, MPNZR, MPOUT, MPOUT2,  MPOVFL,  MPPI,
     MPPWR,  MPQPWR,  MPREC, MPROOT, MPSET, MPSIN, MPSIN1, MPSQRT, MPSTR, MPSUB,
     MPUNFL, MP40D, MP40E, AND TIMEMP.
0    SEE COMMENTS ON TIMEMP BEFORE RUNNING TESTV.
 
0  TEST2
   *****
0    THIS MAIN PROGRAM TESTS VARIOUS MP ROUTINES, ESPECIALLY THOSE NOT CALLED BY
     PROGRAM TEST.  IT COMPUTES THE CONSTANTS GIVEN IN - COMPUTER APPROXIMATIONS
     (BY  HART,  CHENEY,  LAWSON, MAEHLY, MESZTENYI, RICE, THACHER AND WITZGALL,
     JOHN WILEY, 1968), APPENDIX C, PP. 182-183,  AND  VARIOUS  OTHER  CONSTANTS
     WHICH  ARE  DESCRIBED  IN  THE  COMMENTS.  THE CONSTANTS ARE COMPUTED TO 40
     SIGNIFICANT FIGURES, WITH WORKING  PRECISION  EQUIVALENT  TO  AT  LEAST  42
     SIGNIFICANT  FIGURES.   TO  INCREASE THE PRECISION, IT IS ONLY NECESSARY TO
     ALTER THE STATEMENT IDECPL = 40, AND PERHAPS INCREASE THE DIMENSIONS OF THE
     ARRAYS (AND ALTER THE CALL TO MPSET ACCORDINGLY).
0    TO RUN TEST2 THE FOLLOWING MP ROUTINES ARE REQUIRED - MPABS, MPADD, MPADDI,
     MPADDQ,  MPADD2,  MPADD3,  MPART1,  MPASIN, MPATAN, MPBERN, MPBESJ, MPBES2,
     MPCDM, MPCHK, MPCIM, MPCLR, MPCMD, MPCMDE, MPCMEF,  MPCMF,  MPCMI,  MPCMIM,
     MPCMPA, MPCMPI, MPCMPR, MPCMR, MPCMRE, MPCOMP, MPCOS, MPCOSH, MPCQM, MPCRM,
     MPDAW, MPDIV, MPDIVI, MPDUMP, MPEI, MPEPS, MPERF, MPERFC,  MPERF2,  MPERF3,
     MPERR,  MPEUL,  MPEXP,  MPEXP1,  MPEXT, MPGAM, MPGAMQ, MPGCD, MPHANK, MPIN,
     MPLI, MPLN, MPLNGM, MPLNI, MPLNS, MPL235,  MPMAXR,  MPMINR,  MPMLP,  MPMUL,
     MPMULI,  MPMULQ,  MPMUL2,  MPNEG,  MPNZR,  MPOUT,  MPOUTE,  MPOUT2, MPOVFL,
     MPPACK, MPPI, MPPIGL, MPPOLY, MPPWR, MPPWR2, MPQPWR, MPREC, MPROOT,  MPSET,
     MPSIN, MPSIN1, MPSINH, MPSQRT, MPSTR, MPSUB, MPTAN, MPTANH, MPUNFL, MPUNPK,
     MPZETA, MP40D, MP40E, MP40F AND MP40G.
0    THE  CORRECT  OUTPUT  TO BE EXPECTED FROM THE TEST2 PROGRAM IS INDICATED IN
     THE COMMENTS IN THE SOURCE OF TEST2.
0  TIMEMP
   ******
     REAL VARIABLE = TIMEMP (I)
0    CALLED  BY  TESTV  MAIN  PROGRAM,  SHOULD  RETURN  THE  EXECUTION  TIME  IN
     FLOATING-POINT SECONDS FROM SOME ARBITRARY POINT.   THE  ARGUMENT  I  IS  A
     DUMMY.
0    NOTE  TIMEMP AS SUPPLIED WITH THE MP PACKAGE WRITES A MESSAGE ON  UNIT  LUN
     ****  AND RETURNS 0.0 .  THE BODY OF TIMEMP SHOULD BE REPLACED BY  SUITABLE
     MACHINE-DEPENDENT STATEMENTS.
1                    MP USERS GUIDE (AUGUST 1978)                      PAGE  7.1
07 INDEX OF LINE NUMBERS
 ***********************
0    THE  STARTING  LINE  SEQUENCE  NUMBERS  (GIVEN  IN COLUMNS 73-80) OF THE MP
     ROUTINES (VERSION 780802) ARE AS FOLLOWS.   THE  MP  PACKAGE  WAS  NUMBERED
     MP000010  TO  MP064410 ON 16 SEPT. 1976.  LINES INSERTED, CHANGED, OR MOVED
     SINCE THEN HAVE NUMBERS NOT DIVISIBLE BY 10 OR STARTING MPA...
0      AUG DECK  MPA00010         MPDIVI    MP020380          MPMLP     MP038390
       COMMENTS  MP000061         MPDUMP    MP021510          MPMUL     MP038490
       EXAMPLE   MP005460         MPEI      MP021770          MPMULI    MP039240
       JACOBI    MPA01000         MPEPS     MP022950          MPMULQ    MP039340
       MPABS     MP006190         MPEQ      MP023221          MPMUL2    MP039600
       MPADD     MP006270         MPERF     MP023240          MPNE      MP040461
       MPADDI    MP006350         MPERFC    MP023810          MPNEG     MP040480
       MPADDQ    MP006510         MPERF2    MP024310          MPNZR     MP040560
       MPADD2    MP006630         MPERF3    MP024840          MPOUT     MP041370
       MPADD3    MP007230         MPERR     MP025390          MPOUTE    MP041520
       MPART1    MP008130         MPEUL     MP025580          MPOUTF    MP041781
       MPASIN    MP008610         MPEXP     MP026340          MPOUT2    MP041840
       MPATAN    MP008990         MPEXPA    MP027271          MPOVFL    MP043230
       MPBASA    MP009551         MPEXPB    MP027311          MPPACK    MP043440
       MPBASB    MP009571         MPEXP1    MP027370          MPPI      MP043710
       MPBERN    MP009610         MPEXT     MP028000          MPPIGL    MP043970
       MPBESJ    MP010760         MPGAM     MP028240          MPPOLY    MP044420
       MPBES2    MP011900         MPGAMQ    MP029050          MPPWR     MP044700
       MPCAM     MP012491         MPGCD     MP029311          MPPWR2    MP045130
       MPCDM     MP012580         MPGCDA    MP029371          MPQPWR    MP045440
       MPCHK     MP013250         MPGCDB    MP029531          MPREC     MP046170
       MPCIM     MP013760         MPGE      MP030521          MPROOT    MP046980
       MPCLR     MP014030         MPGT      MP030541          MPSET     MP048040
       MPCMD     MP014160         MPHANK    MP030560          MPSIGA    MP048741
       MPCMDE    MP014560         MPIN      MP031390          MPSIGB    MP048761
       MPCMEF    MP014790         MPINE     MP032570          MPSIN     MP048810
       MPCMF     MP015500         MPINF     MP032761          MPSINH    MP049480
       MPCMI     MP015820         MPINIT    MP032821          MPSIN1    MP049860
       MPCMIM    MP016250         MPIO      MP032921          MPSQRT    MP050440
       MPCMPA    MP016480         MPKSTR    MP032961          MPSTR     MP050680
       MPCMPI    MP016640         MPLE      MP033001          MPSUB     MP050890
       MPCMPR    MP016800         MPLI      MP033020          MPTAN     MP050980
       MPCMR     MP016960         MPLN      MP033380          MPTANH    MP051610
       MPCMRE    MP017310         MPLNGM    MP033940          MPUNFL    MP052000
       MPCOMP    MP017530         MPLNGS    MP034810          MPUNPK    MP052150
       MPCOS     MP017880         MPLNI     MP035580          MPUPK     MP052341
       MPCOSH    MP018170         MPLNS     MP036630          MPZETA    MP052440
       MPCQM     MP018430         MPLT      MP037281          MP40D     MP053590
       MPCRM     MP018630         MPL235    MP037300          MP40E     MP053760
       MPDAW     MP019260         MPMAX     MP037830          MP40F     MP053900
       MPDGA     MP019741         MPMAXR    MP037950          MP40G     MP054080
       MPDGB     MP019781         MPMEXA    MP038051          TEST      MP054220
       MPDIGA    MP019841         MPMEXB    MP038071          TESTV     MP056030
       MPDIGB    MP019861         MPMIN     MP038110          TEST2     MP057940
       MPDIV     MP019900         MPMINR    MP038230          TIMEMP    MP064140
1
 END OF MP USER'S GUIDE
*DESCRIBE MULTIPAK                                                      MPA00010
         ARITHMETIC PACKAGE OF R. P. BRENT, UNIVAC 1100 VERSION.        MPA00030
         THREE TYPES OF VARIABLE ARE DEFINED HERE -                     MPA00040
               MULTIPLE   (STANDARD MULTIPLE-PRECISION NUMBERS),        MPA00050
               MULTIPAK   (PACKED MULTIPLE-PRECISION NUMBERS), AND      MPA00060
               INITIALIZE (USED ONLY AS A DEVICE TO PERSUADE            MPA00070
                           AUGMENT TO INITIALIZE THE MP PACKAGE).       MPA00080
         WORKING SPACE SHOULD BE ALLOCATED AND THE MP PACKAGE           MPA00090
         INITIALIZED BY THE DECLARATION                                 MPA00100
               INITIALIZE MP                                            MPA00110
         IN THE MAIN PROGRAM.                                           MPA00120
         THIS DESCRIPTION DECK ASSUMES THAT MULTIPLE PRECISION NUMBERS  MPA00130
         WILL HAVE NO MORE THAN 10 DIGITS (BASE 65536) FOR A TOTAL      MPA00140
         PRECISION NOT EXCEEDING ABOUT 43 DECIMAL PLACES.  FOR THIS,    MPA00150
         EACH MP NUMBER REQUIRES 12 WORDS (6 IN PACKED FORMAT).         MPA00160
         SEE COMMENTS IN ROUTINE MPINIT FOR THE METHOD OF CHANGING      MPA00170
         THE PRECISION OR ADAPTING TO A MACHINE WITH WORDLENGTH OTHER   MPA00180
         THAN 36 BITS, AND ALSO REGARDING DECLARATION OF BLANK COMMON.  MPA00190
DECLARE INTEGER(6), KIND SAFE SUBROUTINE, PREFIX MPK                    MPA00200
SERVICE COPY(STR)                                                       MPA00210
*DESCRIBE MULTIPLE                                                      MPA00220
DECLARE INTEGER(12), KIND SAFE SUBROUTINE, PREFIX MP                    MPA00230
OPERATOR + (,NULL UNARY, PRV, $), - (NEG, UNARY),                       MPA00240
         + (ADD, BINARY3, PRV, $, $, $, COMM), * (MUL),                 MPA00250
         - (SUB,,,,,, NONCOMM), / (DIV), ** (PWR2),                     MPA00260
         + (ADDI,,,, INTEGER), * (MULI), / (DIVI), ** (PWR),            MPA00270
         .EQ. (EQ, BINARY2, PRV, $, LOGICAL, COMM), .NE. (NE),          MPA00280
         .GE. (GE,,,,, NONCOMM), .GT. (GT), .LE. (LE), .LT. (LT)        MPA00290
TEST     MPSIGA (SIGA, INTEGER)                                         MPA00300
FIELD    SGN (SIGA, SIGB, ($), INTEGER),                                MPA00310
         EXPON (EXPA, EXPB), BASE (BASA, BASB), NUMDIG (DIGA, DIGB),    MPA00320
         MAXEXP (MEXA, MEXB), DIGIT (DGA, DGB, ($, INTEGER))            MPA00330
FUNCTION ABS (ABS, ($), $), ASIN (ASIN), ATAN (ATAN), CMF (CMF),        MPA00340
         CMIM (CMIM), COS (COS), COSH (COSH), DAW (DAW), EI (EI),
         ERF (ERF), ERFC (ERFC), EXP (EXP), EXP1 (EXP1), FRAC (CMF),
         GAM (GAM), INT (CMIM), LI (LI), LN (LN), LOG (LN), LNGM (LNGM),
         LNGS (LNGS), LNS (LNS), REC (REC), SIN (SIN), SINH (SINH),
         SQRT (SQRT), TAN (TAN), TANH (TANH),
         ART1 (ART1, (INTEGER)), LN (LNI), LNI (LNI), LOG (LNI),
         ZETA (ZETA), CAM (CAM), CAM (CAM, (HOLLERITH)),
         MAX (MAX, ($, $)), MIN (MIN), GCD (GCDA),
         BESJ (BESJ, ($, INTEGER)), ROOT (ROOT),
         MPINF (INF(SUBROUTINE),($,INTEGER,INTEGER,HOLLERITH),LOGICAL),
         MPOUTF (OUTF(SUBROUTINE)),
         MPINF (INF(SUBROUTINE), ($, INTEGER, INTEGER, INTEGER)),
         MPOUTF (OUTF(SUBROUTINE)),
         COMP (COMP, ($, $), INTEGER), CMPA (CMPA),
         COMP (CMPI, ($, INTEGER)), COMP (CMPR, ($, REAL)),
         ADDQ (ADDQ, ($, INTEGER, INTEGER), $), MULQ (MULQ),
         QPWR (QPWR, (INTEGER, INTEGER, INTEGER, INTEGER)),
         CQM (CQM, (INTEGER, INTEGER)), CTM (CQM),
         GAM (GAMQ), GAMQ (GAMQ),
         BERN (BERN, (INTEGER, INTEGER), MULTIPAK)
CONVERSION CTM (CDM, DOUBLE PRECISION, $, UPWARD),
         CTM (CIM, INTEGER), CTM (CRM, REAL),
         CTM (UNPK, MULTIPAK), CTM (CAM, HOLLERITH),
         CTD (CMD(SUBROUTINE), $, DOUBLE PRECISION, DOWNWARD),
         CTI (CMI(SUBROUTINE),, INTEGER),
         CTR (CMR(SUBROUTINE),, REAL), CTP (PACK,, MULTIPAK)
SERVICE COPY (STR)
*DESCRIBE INITIALIZE
DECLARE INTEGER(1), KIND SAFE SUBROUTINE, PREFIX MPI
SERVICE COPY (STR), INITIAL (NIT)
COMMENT    END OF AUGMENT DESCRIPTION DECK FOR MP PACKAGE

(MACHINE-DEPENDENT STATMEMENTS TO EXECUTE AUGMENT
 AND ADD DESCRIPTION DECK AS DATA FOR AUGMENT)
*BEGIN
*ENABLE SOURCE, OUTPUT
(MACHINE-DEPENDENT STATEMENT(S) TO INVOKE FORTRAN COMPILER)
C
C PROGRAM TO VERIFY AN IDENTITY OF JACOBI USING THE MP
C PACKAGE AND AUGMENT.
C
C THE PROGRAM READS A NUMBER X IN FREE-FIELD FORMAT ACCEPTABLE TO
C MPIN.  IF X IS NON-POSITIVE IT HALTS.  OTHERWISE IT COMPUTES
C AND PRINTS FN(X), FN(1/X) AND (FN(X)-FN(1/X))/FN(X),
C WHERE  FN(X) IS THE SUM FROM N = -INFINITY TO +INFINITY OF
C SQRT(X)*EXP(-PI*(N*X)**2).
C THE IDENTITY VERIFIED IS
C                           FN(X) = FN(1/X)
C
C DECLARE VARIABLES AND INITIALIZE MP PACKAGE.  ON SOME SYSTEMS BLANK
C COMMON MUST BE DECLARED HERE - SEE COMMENTS IN ROUTINE MPINIT.
C
      LOGICAL ERR
      MULTIPLE X, F1, F2, FN
      INITIALIZE MP
C
C READ X FROM UNIT 5 IN (72A1) FORMAT, STOP IF ERROR
C OR IF X NOT POSITIVE.
C
   10 IF (MPINF (X, 72, 5, 6H(72A1))) STOP
      IF (X.LE.0) STOP
C
C WRITE HEADING, X, FN(X), AND FN(1/X) IN (1X,F50.40) FORMAT
C
      WRITE (6, 20)
   20 FORMAT (//41H X, FN(X), FN(1/X), (FN(X)-FN(1/X))/FN(X)/)
      ERR = MPOUTF (X, 50, 40, 9H(1X,50A1))
      F1 = FN(X)
      ERR = MPOUTF (F1, 50, 40, 9H(1X,50A1))
      F2 = FN(1/X)
      ERR = MPOUTF (F2, 50, 40, 9H(1X,50A1))
C
C WRITE (F1-F2)/F1 IN (1X,F70.60) FORMAT.
C NOTE THAT AN MP EXPRESSION CAN BE AN ARGUMENT OF MPOUTF.
C
      ERR = MPOUTF ((F1-F2)/F1, 70, 60, 9H(1X,70A1))
      GO TO 10
      END
C                                                                       MPA01460
C MULTIPLE PRECISION FUNCTION FOLLOWS                                   MPA01470
C                                                                       MPA01480
(MACHINE-DEPENDENT STATEMENT(S) TO INVOKE FORTRAN COMPILER)             MPA01490
C                                                                       MPA01500
      FUNCTION FN(X)                                                    MPA01510
C
C RETURNS FN(X) = THE SUM FROM N = -INFINITY TO +INFINITY OF
C SQRT(X)*EXP(-PI*(N*X)**2), ASSUMING X POSITIVE.
C USES THE OBVIOUS METHOD, SO SLOW IF X SMALL.
C NOTE THAT X AND FN ARE BOTH TYPE MULTIPLE.
C
      MULTIPLE FN, X, TM, FAC, PR
      IF (X.LE.0) CALL MPERR
      FN = 0
C
C AUGMENT CAN DEAL WITH THE FOLLOWING EXPRESSION AS IT KNOWS THAT X
C IS TYPE MULTIPLE, SO CALLS MPCAM TO CONVERT 2HPI TO MULTIPLE.
C
      TM = EXP(-2HPI*X*X)
      PR = TM
      FAC = TM**2
C
C LOOP TO SUM INFINITE SERIES
C WARNING - NUMBER OF ITERATIONS IS PROPORTIONAL TO 1/X
C
   10 FN = FN + TM
      PR = PR*FAC
      TM = TM*PR
C
C TEST FOR CONVERGENCE BY COMPARING EXPONENTS OF FN AND TM.
C WE COULD ALSO HAVE SAVED THE OLD VALUE OF FN AND SEEN IF
C STATEMENT 10 CHANGED IT.
C
      IF (EXPON(FN)-EXPON(TM).LT.NUMDIG(X)) GO TO 10
      FN = SQRT(X)*(2*FN+1)
      RETURN
      END
*END                                                                    MPA01840
(MACHINE-DEPENDENT STATEMENTS TO COMPILE OUTPUT FROM AUGMENT,           MPA01850
 LINK TO PRECOMPILED MP LIBRARY, AND EXECUTE WITH THE                   MPA01860
 FOLLOWING DATA)                                                        MPA01870
.5                                                                      MPA01880
.3                                                                      MPA01890
10                                                                      MPA01900
1.234567890123456789012345678901234567890123456789                      MPA01910
0                                                                       MPA01920
