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