*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
