newnumal5p3.txt

1SECTION : 5.2.1.1.2.1        (FEBRUARY 1979)                     PAGE 1
 
 
 
 SECTION 5.2.1.1.2.1 CONTAINS FOUR PROCEDURES FOR INITIAL VALUE PROBLEMS
 FOR SECOND ORDER ORDINARY DIFFERENTIAL EQUATIONS.
 
 A.  RK2 SOLVES AN IVP FOR A SINGLE SECOND ORDER ODE BY MEANS OF A
     5-TH ORDER RUNGE-KUTTA METHOD.
 
 B.  RK2N SOLVES AN IVP FOR A SYSTEM OF SECOND ORDER ODE'S BY MEANS
     OF A 5-TH ORDER RUNGE-KUTTA METHOD
 
 C.  RK3 SOLVES AN IVP FOR A SINGLE SECOND ORDER ODE WITHOUT FIRST
     DERIVATIVE. RK3 IS BASED ON A 5-TH ORDER RUNGE-KUTTA METHOD.
 
 D.  RK3N SOLVES AN IOVP FOR A SYSTEM OF SECOND ORDER ODE'S WITHOUT
     FIRST DERIVATIVE. RK3N IS BASED ON A 5-TH ORDER RUNGE-KUTTA METHOD.
 
1SECTION : 5.2.1.1.2.1.A      (FEBRUARY 1979)                     PAGE 1
 
 
 
 PROCEDURE : RK2.
 
 
 AUTHOR: J.A.ZONNEVELD.
 
 
 CONTRIBUTORS: M.BAKKER AND I.BRINK.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 730715.
 
 
 BRIEF DESCRIPTION:
 
     RK2 INTEGRATES THE SCALAR INITIAL VALUE PROBLEM
     (D/DX) (D/DX) Y  = F(X, Y, (D/DX)Y), A<= X <=B OR B <= X <= A,
     Y(A) AND (D/DX) Y(A) PRESCRIBED.
 
 
 KEYWORDS:
 
     INITIAL VALUE PROBLEM,
     SECOND ORDER DIFFERENTIAL EQUATION.
 
 
1SECTION : 5.2.1.1.2.1.A      (FEBRUARY 1979)                     PAGE 2
 
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" RK2(X, A, B, Y, YA, Z, ZA, FXYZ, E, D, FI);
     "VALUE" B, FI; "REAL" X, A, B, Y, YA, Z, ZA, FXYZ;
     "BOOLEAN" FI; "ARRAY" E, D;
     "CODE" 33012;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <VARIABLE>;
         THE INDEPENDENT VARIABLE;
     A:  <ARITHMETIC EXPRESSION>;
         THE INITIAL VALUE OF X;
     B:  <ARITHMETIC EXPRESSION>;
         THE END VALUE OF X, (B <= A IS ALLOWED);
     Y:  <VARIABLE>;
         THE DEPENDENT VARIABLE;
         EXIT :  THE VALUE OF Y(X) AT X = B;
     YA:  <ARITHMETIC EXPRESSION>;
         ENTRY : THE INITIAL VALUE OF Y AT X = A,
     Z:  <VARIABLE>;
         THE DERIVATIVE DY / DX;
         EXIT : THE VALUE OF Z(X) AT X = B;
     ZA:  <ARITHMETIC EXPRESSION>;
         ENTRY : THE INITIAL VALUE OF (D/DX) Y AT X = A;
     FXYZ:  <ARITHMETIC EXPRESSION>;
         THE RIGHT HAND SIDE OF THE DIFFERENTIAL EQUATION;
         FXYZ DEPENDS ON X, Y, Z, GIVING THE VALUE OF (D/DX) (D/DX) Y;
     E:  <ARRAY IDENTIFIER>;
         "ARRAY" E[1 : 4];
         E[1] AND E[3] ARE USED AS RELATIVE , E[2] AND E[4] ARE USED
         AS ABSOLUTE TOLERANCES FOR Y AND DY / DX, RESPECTIVELY;
     D:  <ARRAY IDENTIFIER>;
         "ARRAY" D[1 : 5];
         EXIT:
             ENTIER(D[1] + .5)     =    THE NUMBER OF STEPS SKIPPED,
                    D[2]           =    THE LAST STEP LENGTH USED,
                    D[3]           =    B,
                    D[4]           =    Y(B),
                    D[5]           =    (D/DX) Y, FOR X = B;
     FI:  <BOOLEAN EXPRESSION>;
         IF FI = "TRUE" THEN THE INTEGRATION STARTS AT X=A  WITH A TRIAL
         STEP B - A ; IF FI = "FALSE" THEN THE INTEGRATION IS CONTINUED
         WITH,AS INITIAL CONDITIONS, X = D[3], Y = D[4], Z = D[5], AND
         A, YA AND ZA ARE IGNORED.
 
 
 PROCEDURES USED: NONE.
 
 
1SECTION : 5.2.1.1.2.1.A      (DECEMBER 1979)                     PAGE 3
 
 
 
 METHOD AND PERFORMANCE :
     THE PROCEDURE, WHICH IS PROVIDED WITH STEPLENGTH AND ERROR CONTROL,
     IS BASED ON A 5-TH ORDER RUNGE-KUTTA METHOD.
     A COMPLETE DESCRIPTION IS GIVEN IN [1].
 
 
 REFERENCES:
 
     [1]. J.A.ZONNEVELD.
     AUTOMATIC NUMERICAL INTEGRATION.
     MATH. CENTRE TRACT 8 (1970).
 
 EXAMPLE OF USE:
 
     THE VAN DER POL EQUATION
 
         (D/DX) (D/DX) Y = 10*(1-Y**2)*(DY/DX) - Y, X >= 0,
         Y = 2, DY/DX = 0                , X=0
 
     CAN BE INTEGRATED BY THE PROCEDURE RK2; AT THE POINTS
     X = 9.32386578, 18.86305405, 28.40224162, 37.94142918
     THE DERIVATIVE DY / DX VANISHES; THE PROGRAM WHICH SOLVES THE VAN
     DER POL EQUATION READS AS FOLLOWS (WITH E[I] = "-8, I = 1,...,4):
 
     "BEGIN" "COMMENT" VAN DER POL;
         "REAL" X,Y,Z,B; "BOOLEAN" FI; "ARRAY" E[1:4],D[1:5];
         E[1]:=E[2]:=E[3]:=E[4]:="-8;
         "FOR" B:=9.32386578,18.86305405,28.40224162,37.94142918 "DO"
         "BEGIN" FI:= B<10;
             RK2(X,0.0,B,Y,2.0,Z,0.0,10*(1-Y**2)*Z-Y,E,D,FI);
             OUTPUT(61,"("//10B"("X=")"2D.10D,10B"("Y=")"+2D.10D   ,
             10B"("DY/DX =")",+.5D"-D")",X,Y,Z)
         "END"
     "END"
 
     RESULTS:
 
       X=09.3238657800      Y=-02.0142853609      DY/DX=+.00000"00
 
       X=18.8630540500      Y=+02.0142853609      DY/DX=-.00001"00
 
       X=28.4022416200      Y=-02.0142853609      DY/DX=+.00001"00
 
       X=37.9414291800      Y=+02.0142853608      DY/DX=-.00002"00
1SECTION : 5.2.1.1.2.1.A      (DECEMBER 1979)                     PAGE 4
 
 
 
 SOURCE TEXT(S):
0"CODE" 33012 ;
    "PROCEDURE" RK2(X, A, B, Y, YA, Z, ZA, FXYZ, E, D, FI);
    "VALUE" B, FI; "REAL" X, A, B, Y, YA, Z, ZA, FXYZ; "BOOLEAN" FI;
    "ARRAY" E, D;
    "BEGIN" "REAL" E1, E2, E3, E4, XL, YL, ZL, H, INT, HMIN, HL,
       ABSH, K0, K1, K2, K3, K4, K5, DISCRY, DISCRZ, TOLY,
       TOLZ, MU, MU1, FHY, FHZ;
       "BOOLEAN" LAST, FIRST, REJECT;
       "IF" FI "THEN"
       "BEGIN" D[3]:= A; D[4]:= YA; D[5]:= ZA "END";
       D[1]:= 0; XL:= D[3]; YL:= D[4]; ZL:= D[5];
       "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]);
       "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL);
       HMIN:= INT * E[1] + E[2]; HL:= INT * E[3] + E[4];
       "IF" HL < HMIN "THEN" HMIN:= HL; E1:= E[1] / INT;
       E2:= E[2] / INT; E3:= E[3] / INT; E4:= E[4] / INT;
       FIRST:= "TRUE"; "IF" FI "THEN"
       "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END";
    TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN"
       "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN
       "END";
       "IF" H >= B - XL "EQV" H >= 0 "THEN"
       "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL;
          ABSH:= ABS(H)
       "END"
       "ELSE" LAST:= "FALSE";
    STEP: X:= XL; Y:= YL; Z:= ZL; K0:= FXYZ * H;
       X:= XL + H / 4.5;
       Y:= YL + (ZL * 18 + K0 * 2) / 81 * H;
       Z:= ZL + K0 / 4.5  ; K1:= FXYZ * H; X:= XL + H / 3;
       Y:= YL + (ZL * 6 + K0) / 18 * H;
       Z:= ZL + (K0 + K1 * 3) / 12; K2:= FXYZ * H;
       X:= XL + H * .5;
       Y:= YL + (ZL * 8 + K0 + K2) / 16 * H;
       Z:= ZL + (K0 + K2 * 3) / 8; K3:= FXYZ * H;
       X:= XL + H * .8;
       Y:= YL + (ZL * 100 + K0 * 12 + K3 * 28) / 125 * H;      "COMMENT"
1SECTION : 5.2.1.1.2.1.A      (AUGUST 1974)                       PAGE 5
                                                                  ;
 
 
       Z:= ZL + (K0 * 53 - K1 * 135 + K2 * 126 + K3 * 56)
       / 125; K4:= FXYZ * H; X:= "IF" LAST "THEN" B "ELSE" XL + H;
       Y:= YL + (ZL * 336 + K0 * 21 + K2 * 92 + K4 * 55) /
       336 * H;
       Z:= ZL + (K0 * 133 - K1 * 378 + K2 * 276 + K3 * 112
       + K4 * 25) / 168; K5:= FXYZ * H;
       DISCRY:= ABS(( - K0 * 21 + K2 * 108 - K3 * 112 + K4
       * 25) / 56 * H);
       DISCRZ:= ABS(K0 * 21 - K2 * 162 + K3 * 224 - K4 *
       125 + K5 * 42) / 14;
       TOLY:= ABSH * (ABS(ZL) * E1 + E2);
       TOLZ:= ABS(K0) * E3 + ABSH * E4;
       REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ;
       FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ;
       "IF" FHZ > FHY "THEN" FHY:= FHZ;
       MU:= 1 / (1 + FHY) + .45; "IF" REJECT "THEN"
       "BEGIN" "IF" ABSH <= HMIN "THEN"
          "BEGIN" D[1]:= D[1] + 1; Y:= YL; Z:= ZL;
             FIRST:= "TRUE"; "GOTO" NEXT
          "END";
          H:= MU * H; "GOTO" TEST
       "END";
       "IF" FIRST "THEN"
       "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC
       "END";
       FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H;
    ACC: MU1:= MU;
       Y:= YL + (ZL * 56 + K0 * 7 + K2 * 36 - K4 * 15) / 56
       * HL;
       Z:= ZL + ( - K0 * 63 + K1 * 189 - K2 * 36 - K3 * 112
       + K4 * 50) / 28; K5:= FXYZ * HL;
       Y:= YL + (ZL * 336 + K0 * 35 + K2 * 108 + K4 * 25)
       / 336 * HL;
       Z:= ZL + (K0 * 35 + K2 * 162 + K4 * 125 + K5 * 14)
       / 336;
    NEXT: "IF" B ^= X "THEN"
       "BEGIN" XL:= X; YL:= Y; ZL:= Z; "GOTO" TEST "END";
       "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; D[4]:= Y; D[5]:= Z
    "END" RK2;
         "EOP"
1SECTION : 5.2.1.1.2.1.B      (FEBRUARY 1979)                     PAGE 1
 
 
 
 PROCEDURE : RK2N.
 
 
 AUTHOR:J.A.ZONNEVELD.
 
 
 CONTRIBUTORS: M.BAKKER AND I.BRINK.
 
 
 INSTITUTE : MATHEMATICAL CENTRE.
 
 
 RECEIVED: 730715.
 
 
 BRIEF DESCRIPTION:
 
     RK2N INTEGRATES THE VECTOR INITIAL VALUE PROBLEM
     (D/DX) (D/DX) Y = F(X, Y, (D/DX) Y), A<= X <= B OR B <= X <= A,
     Y[J] (A)  AND  (D/DX) Y[J] (A) PRESCRIBED FOR J=1,....N.
 
 
 KEYWORDS :
 
     INITIAL VALUE PROBLEM,
     SECOND ORDER DIFFERENTIAL EQUATION.
 
 
1SECTION : 5.2.1.1.2.1.B      (FEBRUARY 1979)                     PAGE 2
 
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" RK2N(X,A,B,Y,YA,Z,ZA,FXYZJ,J,E,D,FI,N);
     "VALUE" B,FI,N;
     "INTEGER" J,N;
     "REAL" X,A,B,FXYZJ;
     "BOOLEAN" FI;
     "ARRAY" Y,YA,Z,ZA,E,D;
     "CODE" 33013;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:    <VARIABLE>;
           THE INDEPENDENT VARIABLE.
           UPON COMPLETION OF A CALL OF RK2N,
           IT IS EQUAL TO B;
     A:    <ARITHMETIC EXPRESSION>;
           THE STARTING VALUE OF X;
     B:    <ARITHMETIC EXPRESSION>;
           A VALUE PARAMETER,GIVING THE END VALUE OF X;
     Y:    <ARRAY IDENTIFIER>;
           "ARRAY" Y[1:N];
           THE VECTOR OF DEPENDENT VARIABLES;
           EXIT: THE VALUE OF Y[J] (B), (J = 1, .. ,N);
     YA:   <ARRAY IDENTIFIER>;
           "ARRAY" YA[1:N];
           ENTRY : THE STARTING VALUES OF Y[J],I.E. THE VALUES AT X=A;
     Z:    <ARRAY IDENTIFIER>;
           "ARRAY" Z[1:N];
           THE FIRST DERIVATIVES OF THE DEPENDENT VARIABLES;
           EXIT : THE VALUE OF (D/DX)Y[J](B) (J = 1, .. ,N);
     ZA:   <ARRAY IDENTIFIER>;
           "ARRAY" ZA[1:N];
           ENTRY : THE STARTING VALUES OF Z[J],I.E. THE VALUES AT X=A;
     FXYZJ:<ARITHMETIC EXPRESSION>;
           AN EXPRESSION DEPENDING ON X,J,Y[J],Z[J]  (J=1,...,N),
           GIVING THE VALUE OF (D/DX)(D/DX)Y[J];
     J:    <VARIABLE>;
           A VARIABLE OF TYPE INTEGER,USED IN THE ACTUAL PARAMETER
           CORRESPONDING TO FXYZJ,TO DENOTE THE NUMBER OF THE
           EQUATION REQUIRED (JENSEN'S DEVICE);
     E:    <ARRAY IDENTIFIER>;
           "ARRAY" E[1:4*N];
           THE ELEMENT E[2*J-1] IS A RELATIVE AND E[2*J] IS AN ABSOLUTE
           TOLERANCE ASSOCIATED WITH Y[J];
           E[2*(N+J)-1] IS A RELATIVE AND E[2*(N+J)] IS AN ABSOLUTE
           TOLERANCE ASSOCIATED WITH Z[J];
1SECTION : 5.2.1.1.2.1.B      (FEBRUARY 1979)                     PAGE 3
 
 
 
     D:    <ARRAY IDENTIFIER>;
           "ARRAY" D[1:2*N+3];
           EXIT:
           ENTIER(D[1]+.5) IS THE NUMBER OF STEPS SKIPPED;
           D[2] IS THE LAST  STEP LENGTH USED;
           D[3] IS EQUAL TO B;
           D[4],...,D[N+3] ARE EQUAL TO Y[1],...,Y[N] FOR X=B,
           D[N+4],...,D[2*N+3] ARE EQUAL TO THE DERIVATIVES
           Z[1],...,Z[N] FOR X=B;
     FI:   <BOOLEAN EXPRESSION>;
           IF FI="TRUE" THEN THE INTEGRATION STARTS AT A,WITH A TRIAL
           STEP B-A;IF FI="FALSE" THEN THE INTEGRATION IS CONTINUED
           VIZ. WITH INITIAL CONDITIONS:X=D[3],Y[J]=D[J+3],Z[J]=
           D[N+3+J] AND STEP LENGTH H=D[2]*SIGN(B-D[3]), AND
           A, YA, ZA ARE IGNORED;
     N:    <ARITHMETIC EXPRESSION>;
           THE NUMBER OF EQUATIONS.
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
     EIGHT ARRAYS OF ORDER N AND ONE OF ORDER 4 * N ARE USED.
 
 
 METHOD AND PERFORMANCE :
     RK2N INTEGRATES (D/DX)(D/DX)Y = F(X,Y,Z) FROM X TO B,WITH, EITHER
     (IF FI = "TRUE") X=A, Y[J]=YA[J], Z[J]=ZA[J], OR  (IF FI="FALSE")
     X = D[3], Y[J]=D[J+3], Z[J]=D[N+J+3], J=1,...,N, USING A 5-TH ORDER
     RUNGE-KUTTA METHOD.
     UPON COMPLETION OF A CALL OF RK2N WE HAVE:X=D[3]=B, Y[J]=D[J+3]
     THE VALUE OF THE DEPENDENT VARIABLES FOR X=B, Z[J]=D[N+J+3], THE
     VALUE OF THE DERIVATIVES OF Y[J] AT X=B, J=1,...,N.
     RK2N USES AS ITS MINIMAL ABSOLUTE STEP LENGTH
     HMIN=MIN (E[2*J-1]*INT+E[2 *J]) WITH 1<=J<=2*N AND INT=
     ABS(B-("IF" FI "THEN" A "ELSE" D[3])).
     IF A STEP OF LENGTH ABS(H)<=HMIN IS REJECTED, A STEP SIGN(H)*HMIN
     IS SKIPPED.  A STEP IS REJECTED IF THE ABSOLUTE VALUE OF THE
     COMPUTED DISCRETIZATION ERROR IS GREATER THAN
     ( ABS(Z[J]) * E[2 * J - 1] + E[2 * J] ) * ABS(H) / INT
     OR IF THAT TERM IS GREATER THEN (ABS(FXYZJ)*E[2*(J+N)-1
     +E[2*(J+N)])ABS(H)/INT, FOR ANY VALUE OF J ,1<=J<=N (INT=ABS(B-A)).
     SEE REF[1].
 
 
1SECTION : 5.2.1.1.2.1.B      (DECEMBER 1975)                     PAGE 4
 
 
 
 EXAMPLE OF USE:
 
     THE SECOND ORDER (VECTOR) DIFFERENTIAL EQUATION
 
       (D/DX)(D/DX)Y[1] = -5*(Y[1] + (D/DX)Y[2]) + Y[2],
 
       (D/DX)(D/DX)Y[2] = -5*(Y[2] + (D/DX)Y[1]) + Y[1], X>=0,
 
       Y[1] = (D/DX)Y[2] = 1, Y[2] = (D/DX)Y[1] = 0, X=0
 
     WITH ANALYTIC SOLUTION
 
       Y[1] = -EXP(-X)*(EXP(-X)*(EXP(-X)*(EXP(-X)/3+.5)-1)-5/6),
       Y[2] = -EXP(-X)*(EXP(-X)*(EXP(-X)*(EXP(-X)/3-.5)+1)-5/6)
 
     CAN BE INTEGRATED BY RK2N FROM 0 TO 5 WITH  1,2,3,4 AS REFERENCE
     POINTS. THE PROGRAM READS AS FOLLOWS:
 
     "BEGIN" "REAL" B, X, EXPX; "INTEGER" K; "BOOLEAN" FI;
         "ARRAY" Y,YA,Z,ZA[0:2],E[1:8],D[0:7];
         "FOR"  K:=1,2,3,4,5,6,7,8 "DO" E[K]:="-7;
         YA[1]:=ZA[2]:=1; YA[2]:=ZA[1]:=0; B:=1; AA: FI:=B=1;
       RK2N(X,0.0,B,Y,YA,Z,ZA,-5*(Y[K]+Z[K])+("IF"K=1"THEN"Y[2]"ELSE"
         Y[1]),K,E,D,FI,2);
         "COMMENT" COMPUTATION  OF THE EXACT VALUES OF Y AND DY/DX;
         EXPX:=EXP(-X);
         YA[1]:=-EXPX*(EXPX*(EXPX*(EXPX/3+.5)-1)-5/6);
         YA[2]:=-EXPX*(EXPX*(EXPX*(EXPX/3-.5)+1)-5/6);
         ZA[1]:=+EXPX*(EXPX*(EXPX*(EXPX/.75+1.5)-2)-5/6);
         ZA[2]:=+EXPX*(EXPX*(EXPX*(EXPX/.75-1.5)+2)-5/6);
         OUTPUT(61,"("/20B"("X=")"D.4D/,
         10B"("Y[1]-YEXACT[1]=")"+.14D ,10B"("Y[2]-YEXACT[2]=")"+.14D4/,
         10B"("Z[1]-ZEXACT[1]=")"+.14D ,10B"("Z[2]-ZEXACT[2]=")"+.14D
         5/")",X,Y[1]-YA[1],Y[2]-YA[2],Z[1]-ZA[1],Z[2]-ZA[2]);
         B:=B+1; "IF" B<5 "THEN" "GO TO" AA
     "END"
     RESULTS:
 
           X=1.0000
      Y[1]-YEXACT[1]=+.00000000002955     Y[2]-YEXACT[2]=+.0000000000567
      Z[1]-ZEXACT[1]=-.00000000013770     Z[2]-ZEXACT[2]=-.0000000002422
 
           X=2.0000
      Y[1]-YEXACT[1]=-.00000000085294     Y[2]-YEXACT[2]=+.0000000001486
      Z[1]-ZEXACT[1]=+.00000000378800     Z[2]-ZEXACT[2]=-.0000000006509
 
           X=3.0000
      Y[1]-YEXACT[1]=-.00000000162707     Y[2]-YEXACT[2]=-.0000000004796
      Z[1]-ZEXACT[1]=+.00000000803265     Z[2]-ZEXACT[2]=+.0000000019380
 
           X=4.0000
      Y[1]-YEXACT[1]=-.00000000117993    Y[2]-YEXACT[2]=-.0000000008505
      Z[1]-ZEXACT[1]=+.00000000633393     Z[2]-ZEXACT[2]=+.0000000039114
1SECTION : 5.2.1.1.2.1.B      (AUGUST 1974)                       PAGE 5
 
 
 
 SOURCE TEXT(S):
0"CODE" 33013 ;
    "PROCEDURE" RK2N(X, A, B, Y, YA, Z, ZA, FXYZJ, J, E, D,
    FI, N); "VALUE" B, FI, N; "INTEGER" J, N; "REAL" X, A, B, FXYZJ;
    "BOOLEAN" FI; "ARRAY" Y, YA, Z, ZA, E, D;
    "BEGIN" "INTEGER" JJ;
       "REAL" XL, H, INT, HMIN, HL, ABSH, FHM, DISCRY, DISCRZ,
       TOLY, TOLZ, MU, MU1, FHY, FHZ;
       "BOOLEAN" LAST, FIRST, REJECT;
       "ARRAY" YL, ZL, K0, K1, K2, K3, K4, K5[1:N], EE[1:4 *
       N];
       "IF" FI "THEN"
       "BEGIN" D[3]:= A;
          "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
          "BEGIN" D[JJ + 3]:= YA[JJ]; D[N + JJ + 3]:= ZA[JJ]
          "END"
       "END";
       D[1]:= 0; XL:= D[3];
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" YL[JJ]:= D[JJ + 3]; ZL[JJ]:= D[N + JJ + 3] "END";
       "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]);
       "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL);
       HMIN:= INT * E[1] + E[2];
       "FOR" JJ:= 2 "STEP" 1 "UNTIL" 2 * N "DO"
       "BEGIN" HL:= INT * E[2 * JJ - 1] + E[2 * JJ];
          "IF" HL < HMIN "THEN" HMIN:= HL
       "END";
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" 4 * N "DO" EE[JJ]:= E[JJ] / INT;
       FIRST:= "TRUE"; "IF" FI "THEN"
       "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END";
    TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN"
       "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN;
          ABSH:= ABS(H)
       "END";
       "IF" H >= B - XL "EQV" H >= 0 "THEN"
       "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL;
          ABSH:= ABS(H)
       "END"
       "ELSE" LAST:= "FALSE";
    STEP: X:= XL;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ]; Z[JJ]:= ZL[JJ] "END";
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K0[J]:= FXYZJ * H;
       X:= XL + H / 4.5;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 18 + K0[JJ] * 2) /
          81 * H; Z[JJ]:= ZL[JJ] + K0[JJ] / 4.5;
       "END";                                                  "COMMENT"
1SECTION : 5.2.1.1.2.1.B      (AUGUST 1974)                       PAGE 6
                                                                  ;
 
 
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K1[J]:= FXYZJ * H;
       X:= XL + H / 3;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 6 + K0[JJ]) / 18 * H;
          Z[JJ]:= ZL[JJ] + (K0[JJ] + K1[JJ] * 3) / 12
       "END";
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K2[J]:= FXYZJ * H;
       X:= XL + H * .5;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 8 + K0[JJ] + K2[JJ])
          / 16 * H;
          Z[JJ]:= ZL[JJ] + (K0[JJ] + K2[JJ] * 3) / 8
       "END";
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K3[J]:= FXYZJ * H;
       X:= XL + H * .8;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 100 + K0[JJ] * 12 +
          K3[JJ] * 28) / 125 * H;
          Z[JJ]:= ZL[JJ] + (K0[JJ] * 53 - K1[JJ] * 135 +
          K2[JJ] * 126 + K3[JJ] * 56) / 125
       "END";
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K4[J]:= FXYZJ * H;
       X:= "IF" LAST "THEN" B "ELSE" XL + H;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 336 + K0[JJ] * 21 +
          K2[JJ] * 92 + K4[JJ] * 55) / 336 * H;
          Z[JJ]:= ZL[JJ] + (K0[JJ] * 133 - K1[JJ] * 378 +
          K2[JJ] * 276 + K3[JJ] * 112 + K4[JJ] * 25) / 168
       "END";
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K5[J]:= FXYZJ * H;
       REJECT:= "FALSE"; FHM:= 0;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" DISCRY:= ABS(( - K0[JJ] * 21 + K2[JJ] * 108 -
          K3[JJ] * 112 + K4[JJ] * 25) / 56 * H);
          DISCRZ:= ABS(K0[JJ] * 21 - K2[JJ] * 162 + K3[JJ]
          * 224 - K4[JJ] * 125 + K5[JJ] * 42) / 14;
          TOLY:= ABSH * (ABS(ZL[JJ]) * EE[2 * JJ - 1] +
          EE[2 * JJ]);
          TOLZ:= ABS(K0[JJ]) * EE[2 * (JJ + N) - 1] + ABSH
          * EE[2 * (JJ + N)];
          REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ "OR" REJECT;
          FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ;
          "IF" FHZ > FHY "THEN" FHY:= FHZ;
          "IF" FHY > FHM "THEN" FHM:= FHY
       "END";                                                  "COMMENT"
1SECTION : 5.2.1.1.2.1.B      (AUGUST 1974)                       PAGE 7
                                                                  ;
 
 
       MU:= 1 / (1 + FHM) + .45; "IF" REJECT "THEN"
       "BEGIN" "IF" ABSH <= HMIN "THEN"
          "BEGIN" D[1]:= D[1] + 1;
             "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
             "BEGIN" Y[JJ]:= YL[JJ]; Z[JJ]:= ZL[JJ] "END";
             FIRST:= "TRUE"; "GOTO" NEXT
          "END";
          H:= MU * H; "GOTO" TEST
       "END";
       "IF" FIRST "THEN"
       "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC
       "END";
       FHM:= MU * H / HL + MU - MU1; HL:= H; H:= FHM * H;
    ACC: MU1:= MU;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 56 + K0[JJ] * 7 +
          K2[JJ] * 36 - K4[JJ] * 15) / 56 * HL;
          Z[JJ]:= ZL[JJ] + ( - K0[JJ] * 63 + K1[JJ] * 189
          - K2[JJ] * 36 - K3[JJ] * 112 + K4[JJ] * 50) / 28
       "END";
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K5[J]:= FXYZJ * HL;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[JJ]:= YL[JJ] + (ZL[JJ] * 336 + K0[JJ] * 35 +
          K2[JJ] * 108 + K4[JJ] * 25) / 336 * HL;
          Z[JJ]:= ZL[JJ] + (K0[JJ] * 35 + K2[JJ] * 162 +
          K4[JJ] * 125 + K5[JJ] * 14) / 336
       "END";
    NEXT: "IF" B ^= X "THEN"
       "BEGIN" XL:= X;
          "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
          "BEGIN" YL[JJ]:= Y[JJ]; ZL[JJ]:= Z[JJ] "END";
          "GOTO" TEST
       "END";
       "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" D[JJ + 3]:= Y[JJ]; D[N + JJ + 3]:= Z[JJ] "END"
    "END" RK2N;
         "EOP"
1SECTION : 5.2.1.1.2.1.C      (FEBRUARY 1979)                     PAGE 1
 
 
 
 PROCEDURE : RK3
 
 
 AUTHOR:J.A.ZONNEVELD.
 
 
 CONTRIBUTORS: M.BAKKER AND I.BRINK.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 730715.
 
 
 BRIEF DESCRIPTION:
 
     RK3 INTEGRATES THE SCALAR INITIAL VALUE PROBLEM
     (D/DX) (D/DX) Y = F(X,Y)   (WITHOUT THE DERIVATIVE (D/DX) Y IN F),
     A <= X <= B OR B <= X <= A,  Y(A) AND (D/DX) Y(A) PRESCRIBED.
 
 
 KEYWORDS:
 
     INITIAL VALUE PROBLEM,
     SECOND ORDER DIFFERENTIAL EQUATION.
 
 
1SECTION : 5.2.1.1.2.1.C      (DECEMBER 1975)                     PAGE 2
 
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" RK3(X,A,B,Y,YA,Z,ZA,FXY,E,D,FI);
     "VALUE" B,FI;
     "REAL" X,A,B,Y,YA,Z,ZA,FXY;
     "BOOLEAN" FI;
     "ARRAY" E,D;
     "CODE" 33014;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:    <VARIABLE>;
           THE INDEPENDENT VARIABLE.
           UPON COMPLETION OF A CALL OF RK3 ,
           IT IS EQUAL TO B;
     A:    <ARITHMETIC EXPRESSION>;
           THE STARTING VALUE OF X;
     B:    <ARITHMETIC EXPRESSION>;
           A VALUE PARAMETER, GIVING THE END VALUE OF X;
           B <= A IS ALLOWED;
     Y:    <VARIABLE>;
           THE DEPENDENT VARIABLE;
           EXIT : THE VALUE OF Y(X) AT X = B;
     YA:   <ARITHMETIC EXPRESSION>;
           ENTRY : THE VALUE OF Y AT X=A;
     Z:    <VARIABLE>;
           THE DERIVATIVE  DY/DX;
           EXIT : THE VALUE OF DY/DX AT X = B;
     ZA:   <ARITHMETIC EXPRESSION>;
           ENTRY : THE VALUE OF DY/DX AT X=A;
     FXY:  <ARITHMETIC EXPRESSION>;
           AN EXPRESSION,DEPENDING ON X AND Y ,GIVING THE VALUE OF
           (D/DX)(D/DX)Y;
     E:   <ARRAY IDENTIFIER>;
           "ARRAY" E[1:4];
           E[1] AND E[3] ARE USED AS RELATIVE TOLERANCES,
           E[2] AND E[4] ARE USED AS ABSOLUTE TOLERANCES
           FOR Y AND DY/DX, RESPECTIVELY;
     D:    <ARRAY IDENTIFIER>;
           "ARRAY" D[1:5];
           EXIT:
           ENTIER(D[1]+.5) IS THE NUMBER OF STEPS SKIPPED;
           D[2] IS THE LAST STEP LENGTH USED;
           D[3] IS EQUAL TO B;
           D[4] IS EQUAL TO Y(B);
           D[5] IS EQUAL TO DY/DX FOR X=B;
     FI:   <BOOLEAN EXPRESSION>;
           IF FI="TRUE" THEN THE INTEGRATION STARTS AT X=A WITH A TRIAL
           STEP B-A;IF FI="FALSE" THEN THE INTEGRATION IS CONTINUED
           VIZ.  WITH THE INITIAL CONDITIONS X=D[3], Y=D[4], Z=D[5] AND
           STEP LENGTH  H=D[2]*SIGN(B-D[3]); A,YA,ZA ARE IGNORED.
 
 
1SECTION : 5.2.1.1.2.1.C      (FEBRUARY 1979)                     PAGE 3
 
 
 
 PROCEDURES USED : NONE.
 
 
 METHOD AND PERFORMANCE :
     RK3 INTEGRATES (D/DX)(D/DX)Y = F(X,Y) FROM X TO B,WITH IF FI="TRUE"
     THEN X=A, Y=YA,DY/DX=ZA ELSE X=D[3], Y=D[4], Z=D[5].
     A 5-TH ORDER RUNGE-KUTTA METHOD IS USED.
     UPON COMPLETION OF A CALL OF RK3 WE HAVE  X=D[3]=B, Y=D[4]=Y[B],
     Z=D[5], I.E. THE VALUE OF DY/DX FOR X=B.
     RK3 USES AS ITS MINIMAL ABSOLUTE STEP LENGTH
     HMIN=MIN (E[2*J-1]*INT+E[2*J]) WITH 1<=J<=2 AND INT=
     ABS(B-("IF" FI "THEN" A "ELSE" D[3])).
     IF A STEP OF LENGTH ABS(H)<=HMIN IS REJECTED ,A STEP SIGN(H)*HMIN
     IS SKIPPED.  A STEP IS REJECTED IF THE ABSOLUTE VALUE OF THE LAST
     TERM TAKEN INTO ACCOUNT IS GREATER THEN (ABS(DY/DX)*E[1]+E[2])*
     ABS(H)/INT OR IF THAT TERM IS GREATER THEN (ABS(FXY)*E[3]+E[4])*
     ABS(H)/INT ( INT = ABS(B - A) ).
     SEE REF[1].
 
 
 REFERENCES:
     [1]J.A.ZONNEVELD.
        AUTOMATIC NUMERICAL INTEGRATION.
        MATHEMATICAL CENTRE TRACT 8 (1970).
 
 EXAMPLE OF USE:
 
     "BEGIN" "COMMENT" SOLUTION OF Y"=X*Y,Y(0)=0,Y'(0)=1;
 
     "REAL" "PROCEDURE" YEXACT(X);"VALUE" X;"REAL" X;
     "BEGIN" "INTEGER" N;"REAL" X3,S,TERM;
         X3:=X**3;TERM:=X;S:=0;
         "FOR" N:=3,N+3 "WHILE" ABS(TERM)>"-14 "DO"
         "BEGIN" S:=S+TERM;TERM:=TERM*X3/N/(N+1)
         "END";
         YEXACT:=S
     "END";
 
     "REAL" X,B,Y,Z;"BOOLEAN" FI;"ARRAY" D,E[1:5];
     E[1]:=E[3]:="-8;E[2]:=E[4]:="-12;
     "FOR" B:=.25,.50,.75,1.00 "DO"
     "BEGIN" FI:=B<.30;
         RK3(X,0.0,B,Y,0.0,Z,1.0,X*Y,E,D,FI);
         OUTPUT(61,"("10B"("Y-YEXACT=")".10D,5B"("X=")"Z.2D,
         5B"("Y=")"2D.10D//")",Y-YEXACT(X),X,Y)
     "END"
     "END"
1SECTION : 5.2.1.1.2.1.C      (AUGUST 1974)                       PAGE 4
 
 
 
     DELIVERS:
 
     Y-YEXACT=0.0000000000     X= .25     Y=00.2503256420
 
     Y-YEXACT=0.0000000000     X= .50     Y=00.5052238559
 
     Y-YEXACT=0.0000000000     X= .75     Y=00.7766332813
 
     Y-YEXACT=0.0000000000     X=1.00     Y=01.0853396481
 
 
 
 SOURCE TEXT(S):
0"CODE" 33014 ;
    "PROCEDURE" RK3(X, A, B, Y, YA, Z, ZA, FXY, E, D, FI);
    "VALUE" B, FI; "REAL" X, A, B, Y, YA, Z, ZA, FXY; "BOOLEAN" FI;
    "ARRAY" E, D;
    "BEGIN" "REAL" E1, E2, E3, E4, XL, YL, ZL, H, INT, HMIN, HL,
       ABSH, K0, K1, K2, K3, K4, K5, DISCRY, DISCRZ, TOLY,
       TOLZ, MU, MU1, FHY, FHZ;
       "BOOLEAN" LAST, FIRST, REJECT;
       "IF" FI "THEN"
       "BEGIN" D[3]:= A; D[4]:= YA; D[5]:= ZA "END";
       D[1]:= 0; XL:= D[3]; YL:= D[4]; ZL:= D[5];
       "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]);
       "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL);
       HMIN:= INT * E[1] + E[2]; HL:= INT * E[3] + E[4];
       "IF" HL < HMIN "THEN" HMIN:= HL; E1:= E[1] / INT;
       E2:= E[2] / INT; E3:= E[3] / INT; E4:= E[4] / INT;
       FIRST:= REJECT:= "TRUE"; "IF" FI "THEN"
       "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END";
    TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN"
       "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN
       "END";
       "IF" H >= B - XL "EQV" H >= 0 "THEN"
       "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL;
          ABSH:= ABS(H)
       "END"
       "ELSE" LAST:= "FALSE";                                  "COMMENT"
1SECTION : 5.2.1.1.2.1.C      (AUGUST 1974)                       PAGE 5
                                                                  ;
 
 
    STEP: "IF" REJECT "THEN"
       "BEGIN" X:= XL; Y:= YL; K0:= FXY * H "END"
       "ELSE" K0:= K5 * H / HL; X:= XL + .276393202250021 * H;
       Y:= YL + (ZL * .2763932022 50021 + K0 *
       .038196601125011) * H; K1:= FXY * H;
       X:= XL + .72360 6797749979 * H;
       Y:= YL + (ZL * .723606797749979 + K1 * .26180
       3398874989) * H; K2:= FXY * H; X:= XL + H * .5;
       Y:= YL + (ZL * .5 + K0 * .046875 + K1 *
       .079824155839840 - K2 * .001699155839840) * H;
       K4:= FXY * H; X:= "IF" LAST "THEN" B "ELSE" XL + H;
       Y:= YL + (ZL + K0 * .309016994374947 + K2 *
       .190983005625053) * H; K3:= FXY * H;
       Y:= YL + (ZL + K0 * .083333333333333 + K1 *
       .301502832395825 + K2 * .115163834270842) * H;
       K5:= FXY * H;
       DISCRY:= ABS(( - K0 * .5 + K1 * 1.809016994374947 +
       K2 * .690983005625053 - K4 * 2) * H);
       DISCRZ:= ABS((K0 - K3) * 2 - (K1 + K2) * 10 + K4 *
       16 + K5 * 4); TOLY:= ABSH * (ABS(ZL) * E1 + E2);
       TOLZ:= ABS(K0) * E3 + ABSH * E4;
       REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ;
       FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ;
       "IF" FHZ > FHY "THEN" FHY:= FHZ;
       MU:= 1 / (1 + FHY) + .45; "IF" REJECT "THEN"
       "BEGIN" "IF" ABSH <= HMIN "THEN"
          "BEGIN" D[1]:= D[1] + 1; Y:= YL; Z:= ZL;
             FIRST:= "TRUE"; "GOTO" NEXT
          "END";
          H:= MU * H; "GOTO" TEST
       "END";
       "IF" FIRST "THEN"
       "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC
       "END";
       FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H;
    ACC: MU1:= MU;
       Z:= ZL + (K0 + K3) * .083333333333333 + (K1 + K2) *
       .416666666666667;
    NEXT: "IF" B ^= X "THEN"
       "BEGIN" XL:= X; YL:= Y; ZL:= Z; "GOTO" TEST "END";
       "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X; D[4]:= Y; D[5]:= Z
    "END" RK3;
         "EOP"
1SECTION : 5.2.1.1.2.1.D      (FEBRUARY 1979)                     PAGE 1
 
 
 
 PROCEDURE : RK3N.
 
 
 AUTHOR:J.A.ZONNEVELD.
 
 CONTRIBUTORS: M.BAKKER AND I.BRINK.
 
 INSTITUTE:MATHEMATICAL CENTRE.
 
 RECEIVED: 730715.
 
 BRIEF DESCRIPTION:
 
     RK3N INTEGRATES THE VECTOR INITIAL VALUE  PROBLEM
     (D/DX) (D/DX) Y = F(X,Y), A <= X <= B OR B <= X <= A,
     Y[J] (A)  AND  (D/DX) Y[J] (A)  PRESCRIBED.
 
 KEYWORDS:
 
     INITIAL VALUE PROBLEM,
     SECOND ORDER DIFFERENTIAL EQUATION.
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" RK3N(X,A,B,Y,YA,Z,ZA,FXYJ,J,E,D,FI,N);
     "VALUE" B,FI,N;
     "INTEGER" J,N;
     "REAL" X,A,B,FXYJ;
     "BOOLEAN" FI;
     "ARRAY" Y,YA,Z,ZA,E,D;
     "CODE" 33015;
 
1SECTION : 5.2.1.1.2.1.D      (DECEMBER 1975)                     PAGE 2
 
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:    <VARIABLE>;
           THE INDEPENDENT VARIABLE.
           UPON COMPLETION OF A CALL OF RK3N,
           IT IS EQUAL TO B;
     A:    <ARITHMETIC EXPRESSION>;
           THE STARTING VALUE OF X;
     B:    <ARITHMETIC EXPRESSION>;
           A VALUE PARAMETER,GIVING THE END VALUE OF X;
           B <= A IS ALLOWED.
     Y:    <ARRAY IDENTIFIER>;
           "ARRAY" Y[1:N];
           THE VECTOR OF DEPENDENT VARIABLES;
           EXIT : THE VALUE OF Y[J](X) AT X = B;
     YA:   <ARRAY IDENTIFIER>;
           "ARRAY" YA[1:N];
           ENTRY : THE STARTING VALUES OF Y[J],I.E. THE VALUES AT X=A;
     Z:    <ARRAY IDENTIFIER>;
           "ARRAY" Z[1:N];
           THE DERIVATIVES OF THE DEPENDENT VARIABLES, Z[J] = DY[J]/DX;
           EXIT : THE VALUE OF Z[J](X) AT X = B;
     ZA:   <ARRAY IDENTIFIER>;
           "ARRAY" ZA[1:N];
           ENTRY : THE STARTING VALUES OF Z[J],I.E. THE VALUES AT X=A;
     FXYJ: <ARITHMETIC EXPRESSION>;
           AN EXPRESSION DEPENDING ON X,Y[1],...,Y[N],J,
           GIVING THE VALUE OF (D/DX)(D/DX)Y[J];
     J:    <VARIABLE>;
           A VARIABLE OF TYPE INTEGER,USED IN THE ACTUAL PARAMETER
           CORRESPONDING TO FXYJ,TO DENOTE THE NUMBER OF THE EQUATION
           REQUIRED (JENSEN'S DEVICE);
     E:    <ARRAY IDENTIFIER>;
           "ARRAY" E[1:4*N];
           THE ELEMENT E[2*J-1] IS A RELATIVE AND E[2*J] IS AN ABSOLUTE
           TOLERANCE ASSOCIATED WITH Y[J];
           E[2*(N+J)-1] IS A RELATIVE AND E[2*(N+J)] IS AN ABSOLUTE
           TOLERANCE ASSOCIATED WITH Z[J];
     D:    <ARRAY IDENTIFIER>;
           "ARRAY" D[1:2*N+3];
           EXIT:
           ENTIER(D[1]+.5) IS THE NUMBER OF STEPS SKIPPED;
           D[2] IS THE LAST STEP LENGTH USED;
           D[3] IS EQUAL TO B;
           D[4],...,D[N+3] ARE EQUAL TO Y[1],...,Y[N] FOR X=B;
           D[N+4],...,D[2*N+3] ARE EQUAL TO THE DERIVATIVES
           Z[1],...,Z[N] FOR X=B;
     FI:   <BOOLEAN EXPRESSION>;
           IF FI="TRUE" THEN THE INTEGRATION STARTS AT A ,WITH A TRIAL
           STEP B-A;IF FI="FALSE" THEN THE INTEGRATION IS CONTINUED VIZ.
           WITH THE INITIAL CONDITIONS:X=D[3],Y[J]=D[J+3],Z[J]=D[N+J+3],
           AND STEP LENGTH H=D[2]*SIGN(B-D[3]); A,YA,ZA ARE IGNORED;
     N:    <ARITHMETIC EXPRESSION>;
           THE NUMBER OF EQUATIONS.
 
 
1SECTION : 5.2.1.1.2.1.D      (FEBRUARY 1979)                     PAGE 3
 
 
 
 PROCEDURES USED: NONE.
 
 REQUIRED CENTRAL MEMORY:
     EIGHT ARAYS OF ORDER N AND ONE OF ORDER 4 * N ARE USED.
 
 METHOD AND PERFORMANCE :
     RK3N INTEGRATES (D/DX)(D/DX)Y=F(X,Y) FROM X TO B,WITH,IF FI="TRUE"
     THEN X=A, Y[J]=YA[J], Z[J]=ZA[J].IF FI="FALSE" THEN X=D[3],
     Y[J]=D[J+3], Z[J]=D[N+3+J], USING A 5-TH ORDER RUNGE-KUTTA METHOD.
     UPON COMPLETION OF A CALL OF RK3N WE HAVE X=D[3]=B, Y[J]=D[J+3]
     THE VALUE OF THE DEPENDENT VARIABLES FOR X=B, Z[J]= D[N+3+J],
     THE VALUE OF THE DERIVATIVES OF Y[J] AT X=B.
     RK3N USES AS ITS MINIMAL ABSOLUTE STEP LENGTH:
     HMIN=MIN (E[2*J-1]*INT+E[2*J]) ,WITH 1<=J<=2*N AND INT=
     ABS(B-("IF" FI "THEN" A "ELSE" D[3])).
     IF A STEP OF LENGTH ABS(H)<=HMIN IS REJECTED,A STEP SIGN(H)*HMIN IS
     SKIPPED.
     A STEP IS REJECTED IF THE ABSOLUTE VALUE OF THE LAST TERM
     TAKEN INTO ACCOUNT IS GREATER THEN (ABS(Z[J])*E[2*J-1]+E[2*J])*
     ABS(H)/INT OR IF THAT TERM IS GREATER THEN (ABS(FXYJ)*E[2*(J+N)-1]
     +E[2*(J+N)])*ABS(H)/INT FOR ANY VALUE OF J, 1<=J<=N (INT=ABS(B-A)).
     SEE REF[1].
 
 REFERENCES:
     [1]J.A.ZONNEVELD.
        AUTOMATIC NUMERICAL INTEGRATION.
        MATHEMATICAL CENTRE TRACT 8 (1970).
 
 EXAMPLE OF USE:
     THE SECOND ORDER (VECTOR) DIFFERENTIAL EQUATION
 
         (D/DX)(D/DX)Y[1] = +Y[2],
 
         (D/DX)(D/DX)Y[2] = -Y[1], X>=0,
 
         Y[1] = Y[2] = 1,
 
         (D/DX)Y[1] = (D/DX)Y[2] = 0, X = 0,
 
     WHOSE EXACT SOLUTION IS GIVEN BY
 
      Y[1]=COSH(X/SQRT(2))*COS(X/SQRT(2))+SINH(X/SQRT(2))*SIN(X/SQRT(2))
      Y[2]=COSH(X/SQRT(2))*COS(X/SQRT(2))-SINH(X/SQRT(2))*SIN(X/SQRT(2))
 
     CAN BE INTEGRATED BY RK3N BECAUSE THE SECOND DERIVATIVE IS NOT
     EXPRESSED IN THE FIRST. THE PROGRAM READS AS FOLLOWS:
 
1SECTION : 5.2.1.1.2.1.D      (AUGUST 1974)                       PAGE 4
 
 
 
     "BEGIN" "INTEGER" K,B; "REAL" X; "BOOLEAN" FI;
         "ARRAY" Y,YA,Z[1:2],E[1:8],D[0:7];
         "INTEGER" "PROCEDURE" EVEN(N); "VALUE" N; "INTEGER" N;
         EVEN:= "IF" N//2 = N/2 "THEN" +1 "ELSE" -1;
         "PROCEDURE" EXACT(X,Y); "VALUE" X; "REAL" X; "ARRAY" Y;
         "BEGIN" "INTEGER" I,N; "REAL" X2,TERM;
             Y[1]:=Y[2]:=0; TERM:=1; X2:= X*X*.5;
             "FOR" N:=1, N+1 "WHILE" ABS(TERM)>"-14 "DO"
             "BEGIN" "FOR" I:=1,2 "DO"
                 Y[I]:=Y[I] + TERM*EVEN((I+N-2)//2);
                 TERM:= TERM*X2  /N/(N*2-1)
             "END"
         "END";
         "FOR" K:=1,2,3,4,5,6,7,8 "DO" E[K]:="-7; FI:= "TRUE";
         Y[1]:=Y[2]:=1; Z[1]:=Z[2]:=0; B:=0; AA: B:= B+1;
       RK3N(X,0.0,B,Y,Y,Z,Z,"IF"K=1"THEN"Y[2]"ELSE"-Y[1],K,E,D,FI,2);
         EXACT(X,YA); OUTPUT(61,"("//10B
         "("ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=")".10D"(""00")"
            ")", ABS(Y[1]-YA[1])+ABS(YA[2]-Y[2]) );
         FI:="FALSE" ; "IF" B<5 "THEN" "GO TO" AA
     "END"
     RESULTS:
     FOR X=1,2,3,4,5 THE FOLLOWING ERRORS ARE NOTICED (E[K]="-7,
     K=1,...,8):
           ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.0000000005"00
           ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.0000000018"00
           ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.0000000046"00
           ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.0000000126"00
           ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.0000000293"00
 
 
 
 SOURCE TEXT(S):
0"CODE" 33015 ;
    "PROCEDURE" RK3N(X, A, B, Y, YA, Z, ZA, FXYJ, J, E, D,
    FI, N); "VALUE" B, FI, N; "INTEGER" J, N; "REAL" X, A, B, FXYJ;
    "BOOLEAN" FI; "ARRAY" Y, YA, Z, ZA, E, D;
    "BEGIN" "INTEGER" JJ;
       "REAL" XL, H, HMIN, INT, HL, ABSH, FHM, DISCRY, DISCRZ,
       TOLY, TOLZ, MU, MU1, FHY, FHZ;
       "BOOLEAN" LAST, FIRST, REJECT;
       "ARRAY" YL, ZL, K0, K1, K2, K3, K4, K5[1:N], EE[1:4 *
       N];
       "IF" FI "THEN"
       "BEGIN" D[3]:= A;
          "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
          "BEGIN" D[JJ + 3]:= YA[JJ]; D[N + JJ + 3]:= ZA[JJ]
          "END"
       "END";                                                  "COMMENT"
1SECTION : 5.2.1.1.2.1.D      (AUGUST 1974)                       PAGE 5
                                                                  ;
 
 
       D[1]:= 0; XL:= D[3];
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" YL[JJ]:= D[JJ + 3]; ZL[JJ]:= D[N + JJ + 3] "END";
       "IF" FI "THEN" D[2]:= B - D[3]; ABSH:= H:= ABS(D[2]);
       "IF" B - XL < 0 "THEN" H:= - H; INT:= ABS(B - XL);
       HMIN:= INT * E[1] + E[2];
       "FOR" JJ:= 2 "STEP" 1 "UNTIL" 2 * N "DO"
       "BEGIN" HL:= INT * E[2 * JJ - 1] + E[2 * JJ];
          "IF" HL < HMIN "THEN" HMIN:= HL
       "END";
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" 4 * N "DO" EE[JJ]:= E[JJ] / INT;
       FIRST:= REJECT:= "TRUE"; "IF" FI "THEN"
       "BEGIN" LAST:= "TRUE"; "GOTO" STEP "END";
    TEST: ABSH:= ABS(H); "IF" ABSH < HMIN "THEN"
       "BEGIN" H:= "IF" H > 0 "THEN" HMIN "ELSE" - HMIN; ABSH:= HMIN
       "END";
       "IF" H >= B - XL "EQV" H >= 0 "THEN"
       "BEGIN" D[2]:= H; LAST:= "TRUE"; H:= B - XL;
          ABSH:= ABS(H)
       "END"
       "ELSE" LAST:= "FALSE";
    STEP: "IF" REJECT "THEN"
       "BEGIN" X:= XL;
          "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ];
          "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K0[J]:= FXYJ * H
       "END"
       "ELSE"
       "BEGIN" FHY:= H / HL;
          "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" K0[JJ]:= K5[JJ] * FHY
       "END";
       X:= XL + .27639 3202250021 * H;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ]
       * .276393202250021 + K0[JJ] * .038196601125011) * H;
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K1[J]:= FXYJ * H;
       X:= XL + .723606797749979 * H;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ]
       * .723606797749979 + K1[JJ] * .261803398874989) * H;
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K2[J]:= FXYJ * H;
       X:= XL + H * .5;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ]
       * .5 + K0[JJ] * .046875 + K1[JJ] * .079824155839840
       - K2[JJ] * .00169 9155839840) * H;
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K4[J]:= FXYJ * H;
       X:= "IF" LAST "THEN" B "ELSE" XL + H;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ]
       + K0[JJ] * .309016994374947 + K2[JJ] *
       .190983005625053) * H;                                  "COMMENT"
1SECTION : 5.2.1.1.2.1.D      (AUGUST 1974)                       PAGE 6
                                                                  ;
 
 
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K3[J]:= FXYJ * H;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Y[JJ]:= YL[JJ] + (ZL[JJ]
       + K0[JJ] * .083333333333333 + K1[JJ] * .30150
       2832395825 + K2[JJ] * .115163834270842) * H;
       "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO" K5[J]:= FXYJ * H;
       REJECT:= "FALSE"; FHM:= 0;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" DISCRY:= ABS(( - K0[JJ] * .5 + K1[JJ] *
          1.809016994374947 + K2[JJ] * .690983005625053 -
          K4[JJ] * 2) * H);
          DISCRZ:= ABS((K0[JJ] - K3[JJ]) * 2 - (K1[JJ] +
          K2[JJ]) * 10 + K4[JJ] * 16 + K5[JJ] * 4);
          TOLY:= ABSH * (ABS(ZL[JJ]) * EE[2 * JJ - 1] +
          EE[2 * JJ]);
          TOLZ:= ABS(K0[JJ]) * EE[2 * (JJ + N) - 1] + ABSH
          * EE[2 * (JJ + N)];
          REJECT:= DISCRY > TOLY "OR" DISCRZ > TOLZ "OR" REJECT;
          FHY:= DISCRY / TOLY; FHZ:= DISCRZ / TOLZ;
          "IF" FHZ > FHY "THEN" FHY:= FHZ;
          "IF" FHY > FHM "THEN" FHM:= FHY
       "END";
       MU:= 1 / (1 + FHM) + .45; "IF" REJECT "THEN"
       "BEGIN" "IF" ABSH <= HMIN "THEN"
          "BEGIN" D[1]:= D[1] + 1;
             "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
             "BEGIN" Y[JJ]:= YL[JJ]; Z[JJ]:= ZL[JJ] "END";
             FIRST:= "TRUE"; "GOTO" NEXT
          "END";
          H:= MU * H; "GOTO" TEST
       "END" REJ;
       "IF" FIRST "THEN"
       "BEGIN" FIRST:= "FALSE"; HL:= H; H:= MU * H; "GOTO" ACC
       "END";
       FHY:= MU * H / HL + MU - MU1; HL:= H; H:= FHY * H;
    ACC: MU1:= MU;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO" Z[JJ]:= ZL[JJ] + (K0[JJ]
       + K3[JJ]) * .083333333333333 + (K1[JJ] + K2[JJ]) *
       .416666666666667;
    NEXT: "IF" B ^= X "THEN"
       "BEGIN" XL:= X;
          "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
          "BEGIN" YL[JJ]:= Y[JJ]; ZL[JJ]:= Z[JJ] "END";
          "GOTO" TEST
       "END";
       "IF" "NOT"LAST "THEN" D[2]:= H; D[3]:= X;
       "FOR" JJ:= 1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" D[JJ + 3]:= Y[JJ]; D[N + JJ + 3]:= Z[JJ] "END"
    "END" RK3N;
         "EOP"
1SECTION : 5.2.1.1.3          (NOVEMBER 1976)                     PAGE 1
 
 
 
 AUTHORS:  P.A. BEENTJES, H.G.J. ROZENHART.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 760201
 
 
 BRIEF DESCRIPTION:
 
     ARKMAT SOLVES AN INITIAL VALUE PROBLEM, GIVEN AS A SYSTEM OF  FIRST
     ORDER (NON-LINEAR) DIFFERENTIAL EQUATIONS BY  MEANS OF A STABILIZED
     RUNGE KUTTA METHOD;
     IN PARTICULAR THIS  PROCEDURE IS  SUITABLE  FOR THE  INTEGRATION OF
     SYSTEMS  WHERE  THE DEPENDENT VARIABLE AND THE  RIGHTHAND  SIDE ARE
     STORED  IN  A   RECTANGULAR   ARRAY  INSTEAD  OF  A  VECTOR ,  I.E.
     DU / DT = F( T, U), WHERE U AND F ARE (N * M) MATRICES ( SEE METHOD
     AND PERFORMANCE).
 
 
 KEYWORDS:
 
     MATRIX DIFFERENTIAL EQUATIONS,
     INITIAL VALUE PROBLEMS,
     EXPLICIT ONE-STEP METHODS,
     STABILIZED RUNGE KUTTA METHODS.
 
 
 CALLING SEQUENCE:
 
     THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS:
 
     "PROCEDURE" ARKMAT(T, TE, M, N, U, DER, TYPE, ORDER, SPR, OUT);
     "VALUE" M, N, TYPE, ORDER; "INTEGER" M, N, TYPE, ORDER;
     "REAL" T, TE, SPR; "ARRAY" U; "PROCEDURE" DER, OUT;
     "CODE" 33066;
1SECTION : 5.2.1.1.3          (FEBRUARY 1979)                     PAGE 2
 
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS
     T:      <VARIABLE>;
             THE INDEPENDENT VARIABLE T;
             ENTRY: THE INITIAL VALUE T0;
             EXIT : THE FINAL VALUE TE;
     TE:     <ARITHMETIC EXPRESSION>;
             ENTRY: THE FINAL VALUE OF T;
     M:      <ARITHMETIC EXPRESSION>;
             NUMBER OF COLUMNS OF U;
     N:      <ARITHMETIC EXPRESSION>;
             NUMBER OF ROWS OF U;
     U:      <ARRAY IDENTIFIER>;
             "ARRAY" U[1:N,1:M];
             ENTRY: THE INITIAL VALUES OF THE SOLUTION OF THE  SYSTEM OF
                    DIFFERENTIAL EQUATIONS AT T=T0;
             EXIT : THE VALUES OF THE SOLUTION AT T=TE;
     DER:    <PROCEDURE IDENTIFIER>;
             THE HEADING OF THIS PROCEDURE READS:
             "PROCEDURE" DER(T, V, FTV); "VALUE" T;
             "REAL" T; "ARRAY" V, FTV;
             THIS  PROCEDURE  MUST BE  GIVEN  BY THE  USER AND  PERFORMS
             AN  EVALUATION  OF  THE  RIGHTHAND  SIDE  F( T, V)  OF  THE
             SYSTEM; UPON  COMPLETION OF  DER,THE RIGHTHAND SIDE SHOULD
             BE STORED IN FTV[1:N,1:M];
     TYPE:   <VARIABLE>;
             ENTRY: THE TYPE OF THE SYSTEM OF DIFFERENTIAL  EQUATIONS TO
                    BE SOLVED;
                    THE USER  SHOULD SUPPLY ONE OF THE FOLLOWING VALUES;
                    1: IF NO SPECIFICATION OF THE TYPE CAN BE MADE;
                    2: IF THE EIGENVALUES OF THE  JACOBIAN MATRIX OF THE
                       RIGHTHAND SIDE ARE NEGATIVE REAL;
                    3: IF THE EIGENVALUES OF THE  JACOBIAN MATRIX OF THE
                       RIGHTHAND SIDE ARE PURELY IMAGINARY;
     ORDER:  <VARIABLE>;
             THE ORDER OF THE RUNGE KUTTA METHOD USED;
             ENTRY: FOR  TYPE=2 THE  USER MAY CHOOSE ORDER=1 OR ORDER=2;
                    ORDER SHOULD BE 2 FOR THE OTHER TYPES;
     SPR:    <ARITHMETIC EXPRESSION>;
             ENTRY: THE SPECTRAL RADIUS OF THE  JACOBIAN  MATRIX OF  THE
                    RIGHTHAND SIDE, WHEN THE SYSTEM IS  WRITTEN IN ONE
                    DIMENSIONAL FORM (I.E. VECTORFORM);
             THE INTEGRATION STEP WILL  EQUAL CONSTANT/SPR (SEE DATA AND
             RESULTS);
             IF NECESSARY SPR  CAN BE UPDATED (AFTER EACH STEP) BY MEANS
             OF THE PROCEDURE OUT;
     OUT:    <PROCEDURE IDENTIFIER>
             THE HEADING OF THIS PROCEDURE READS:
             "PROCEDURE" OUT;
             AFTER EACH INTEGRATION STEP  PERFORMED, INFORMATION  CAN BE
             OBTAINED  OR  UPDATED BY THIS PROCEDURE, E.G. THE VALUES OF
             T, U[1:N,1:M] AND SPR.
1SECTION : 5.2.1.1.3          (FEBRUARY 1979)                     PAGE 3
 
 
 
 DATA AND RESULTS:
 
     IF THE USER WANTS TO PERFORM THE INTEGRATION WITH A PRESCRIBED STEP
     H, HE HAS TO GIVE SPR THE VALUE CONSTANT/H, WHERE CONSTANT HAS  THE
     FOLLOWING VALUES:
     CONSTANT= 4.3 IF TYPE=1 AND ORDER=2;
     CONSTANT= 156 IF TYPE=2 AND ORDER=1;
     CONSTANT=  64 IF TYPE=2 AND ORDER=2;
     CONSTANT=   8 IF TYPE=3 AND ORDER=2;
 
 
 PROCEDURES USED:
 
     ELMCOL = CP34023,
     DUPMAT = CP31035.
 
 
 REQUIRED CENTRAL MEMORY:
 
     TWO AUXILIARY ARRAYS OF ORDER N*M ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     ARKMAT IS AN  IMPLEMENTATION  OF LOW ORDER  STABILIZED  RUNGE KUTTA
     METHODS (SEE REFERENCE[1]);
     THE INTEGRATION STEPSIZE USED WILL DEPEND ON:
     1. THE TYPE OF SYSTEM TO  BE SOLVED (I.E. HYPERBOLIC OR PARABOLIC);
     2. THE SPECTRAL  RADIUS  OF  THE  JACOBIAN  MATRIX  OF  THE SYSTEM;
     3. THE INDICATED ORDER  OF   THE  PARTICULAR  RUNGE  KUTTA  METHOD;
     THE  PROCEDURE   ARKMAT  IS   ESPECIALLY  INTENDED  FOR  SYSTEMS OF
     DIFFERENTIAL EQUATIONS ARISING FROM INITIAL BOUNDARY VALUE PROBLEMS
     IN TWO DIMENSIONS, E.G. WHEN THE METHOD OF LINES IS APPLIED TO THIS
     KIND OF PROBLEMS,THE RIGHTHAND SIDE OF THE RESULTING SYSTEM IS MUCH
     EASIER TO DESCRIBE IN  MATRIX THAN IN VECTOR  FORM; BECAUSE OF THIS
     FACT THE ARRAY OF DEPENDENT VARIABLES U IS A  MATRIX, RATHER THAN A
     VECTOR.
 
 
 REFERENCE:
 
     [1]. P.J. VAN DER HOUWEN.
             STABILIZED RUNGE KUTTA METHOD WITH LIMITED
             STORAGE REQUIREMENTS.
             MATH. CENTR. REPORT TW 124/71.
1SECTION : 5.2.1.1.3          (NOVEMBER 1976)                     PAGE 4
 
 
 
 EXAMPLE OF USE:
 
     GIVEN THE FOLLOWING SYSTEM OF EQUATIONS:
 
          DU / DT = V( T, X, Y),
     (1)
          DV / DT = D( DU / DX) / DX + D( DU / DY) / DY,
 
     ( ORIGINATING FROM THE INITIAL BOUNDARY VALUE PROBLEM
       D( DU / DT) / DT = D( DU / DX) / DX + D( DU / DY) / DY,
       ON  THE  DOMAIN  0 <= X <= PI ,  0 <= Y <= 1 ),
 
     WITH THE FOLLOWING BOUNDARY CONDITIONS:
 
     U( T, 0, Y) = U( T, PI, Y) = U( T, X, 1) = 0,
     U( T, X, 0) = SIN( X ) * COS( SQRT( 1 + PI * PI / 4) * T),
 
     AND THE INITIAL VALUES:
 
     U( 0, X, Y) = SIN( X ) * COS( PI * Y / 2),
     V( 0, X, Y) = 0;
 
     BY APPLYING THE METHOD OF LINES TO PROBLEM (1), USING A TEN BY  TEN
     GRID ON THE INDICATED DOMAIN, THE SYSTEM IS TRANSFORMED TO A MATRIX
     -DIFFERENTIAL EQUATION; THE  SOLUTION OF THE LATTER  PROBLEM AT T=1
     IS COMPUTED BY THE FOLLOWING PROGRAM, USING A CONSTANT STEPSIZE .1;
 
 
 "BEGIN" "REAL" HPI,H1,H2,H1K,H2K,T,TE;
    "INTEGER" I,J,N,M,TYP,ORDE,TEL;"ARRAY" U[1:20,1:10];
 
    "PROCEDURE" DERIV(T,U,DU); "VALUE" T; "REAL" T;"ARRAY" U,DU;
    "BEGIN" "FOR" I:=2 "STEP" 1 "UNTIL" N-1 "DO"
       "FOR" J:=2 "STEP" 1 "UNTIL" M-1 "DO"
       "BEGIN" DU[I,J]:=U[I+N,J];
          DU[I+N,J]:=(U[I,J+1]-2*U[I,J]+U[I,J-1])/H1K+
                     (U[I+1,J]-2*U[I,J]+U[I-1,J])/H2K
       "END";
 
       "FOR" J:=1,M "DO"
       "BEGIN" INIMAT(N+1,N+N,J,J,DU,0);
       "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" DU[I,J]:=U[N+1,J]
       "END";
 
       "FOR" I:=1,N "DO"
       "FOR" J:=2 "STEP" 1 "UNTIL" M-1 "DO"
       "BEGIN" DU[I,J]:=U[I+N,J];
          "IF" I=1 "THEN" DU[N+1,J]:=(U[1,J+1]-2*U[1,J]+U[1,J-1])/H1K+
                                     (2*U[2,J]-2*U[1,J])/H2K
                   "ELSE" DU[2*N,J]:=0
       "END"
    "END" DERIV;
1SECTION : 5.2.1.1.3          (NOVEMBER 1976)                     PAGE 5
 
 
 
    "PROCEDURE" OUT;
    "BEGIN" TEL:=TEL+1;
       "IF" T=TE "THEN"
       "BEGIN" OUTPUT(61,"("//,3B,"("X")",7B,"("Y")",4B,
          "("U(1,X,Y)")",7B,"("U(1,X,Y)")",/,16B,"("COMPUTED")",7B,
          "("EXACT")",//")");
          "FOR" I:= 1 "STEP" 1 "UNTIL" 10 "DO"
          OUTPUT(61,"("2(-D.3D2B),2(-D.6D6B),/")",
          (I-1)*H1,(I-1)*H2,U[I,I],SIN(H1*(I-1))*COS(HPI*H2*(I-1))*
          COS(T*SQRT(1+HPI*HPI)));
          OUTPUT(61,"("/,"("NUMBER OF INTEGRATION STEPS: ")"
          ,ZZZD")",TEL);
          OUTPUT(61,"("//,"(" TYPE IS:")",ZD,"("  ORDER IS:")",
           ZD")",TYP,ORDE);
       "END";
    "END"  OUT;
 
    "PROCEDURE" START;
    "BEGIN" "FOR" J:=1 "STEP" 1 "UNTIL" M "DO" U[N,J]:=SIN(H1*(J-1));
       "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" "REAL" COS1; COS1:=COS(H2*HPI*(I-1));
          "FOR" J:=1 "STEP" 1 "UNTIL" M "DO" U[I,J]:=U[N,J]*COS1
       "END";
       INIMAT(N+1,N+N,1,M,U,0)
    "END" START;
 
    HPI:=2*ARCTAN(1);H2:=1/9;H1:=(2*HPI)/9;N:=M:=10;
    H1K:=H1*H1;H2K:=H2*H2;TEL:=0;
    T:=0; TE:=1 ; START; TYP:=3; ORDE:=2;
    ARKMAT(T,TE,M,N+N,U,DERIV,TYP,ORDE,80.0,OUT)
 "END"
 
     THIS PROGRAM DELIVERS:
 
    X       Y    U(1,X,Y)       U(1,X,Y)
                 COMPUTED       EXACT
 
  0.000   0.000   0.000000       0.000000
  0.349   0.111  -0.095201      -0.096735
  0.698   0.222  -0.170723      -0.173474
  1.047   0.333  -0.211983      -0.215398
  1.396   0.444  -0.213228      -0.216663
  1.745   0.556  -0.178920      -0.181802
  2.094   0.667  -0.122388      -0.124360
  2.443   0.778  -0.062138      -0.063139
  2.793   0.889  -0.016787      -0.017057
  3.142   1.000   0.000000      -0.000000
 
 NUMBER OF INTEGRATION STEPS:   10
 
  TYPE IS: 3  ORDER IS: 2
1SECTION : 5.2.1.1.3          (NOVEMBER 1976)                     PAGE 6
 
 
 
 SOURCE TEXT(S):
0"CODE" 33066;
 "PROCEDURE" ARKMAT( T, TE, M, N, U, DER, TYPE, ORDER, SPR, OUT);
 "VALUE" M,N,TYPE,ORDER;
 "INTEGER" M,N,TYPE,ORDER;
 "REAL" T,TE,SPR;
 "ARRAY" U;
 "PROCEDURE" DER,OUT;
 
 "BEGIN" "INTEGER" SIG,L;
     "REAL" TAU;
     "ARRAY" LAMBDA[1:9],UH,DU[1:N,1:M];
     "BOOLEAN" LAST;
 
     "PROCEDURE" ELMMAT(A,B,X); "VALUE" X; "ARRAY" A,B; "REAL" X;
     "FOR" L:=1 "STEP" 1 "UNTIL" M "DO" ELMCOL(1,N,L,L,A,B,X);
 
     "PROCEDURE" INITIALIZE;
     "BEGIN" "INTEGER" I;"REAL" LBD;
     "SWITCH" TYPEODE:=NOTSPECIFIED2,PARABOLIC1,PARABOLIC2,HYPERBOLIC2;
 
     "IF" TYPE^=2 "AND" TYPE^=3 "THEN" TYPE:=1;
     "IF" TYPE^=2 "THEN" ORDER:=2 "ELSE" "IF" ORDER^=2 "THEN" ORDER:=1;
     I:=1;
     "GOTO" TYPEODE["IF" TYPE=1 "THEN" 1 "ELSE" TYPE+ORDER-1];
 
     NOTSPECIFIED2: "FOR" LBD:=1/9,1/8,1/7,1/6,1/5,1/4,1/3,1/2,4.3 "DO"
                    "BEGIN" LAMBDA[I]:=LBD; I:=I+1 "END";
                    "GOTO" EXIT;
 
     PARABOLIC1:    "FOR"LBD:=.1418519249"-2,.3404154076"-2,.0063118569
                               ,.01082794375,.01842733851,.03278507942,
                               .0653627415,.1691078577,156 "DO"
                    "BEGIN" LAMBDA[I]:=LBD; I:=I+1 "END";
                    "GOTO" EXIT;
 
     PARABOLIC2:    "FOR" LBD:=.3534355908"-2,.8532600867"-2,.015956206
                               ,.02772229155,.04812587964,.08848689452,
                               .1863578961,.5,64 "DO"
                    "BEGIN" LAMBDA[I]:=LBD; I:=I+1 "END";
                    "GOTO" EXIT;
 
     HYPERBOLIC2:   "FOR" LBD:=1/8,1/20,5/32,2/17,17/80,5/22,11/32,1/2,
                               8 "DO"
                    "BEGIN" LAMBDA[I]:=LBD; I:=I+1 "END";
                    "GOTO" EXIT;
                                                              "COMMENT"
1SECTION : 5.2.1.1.3          (NOVEMBER 1976)                     PAGE 7
                                                                      ;
 
 
     EXIT: SIG:=SIGN(TE-T)
 
     "END" INITIALIZE;
 
    "PROCEDURE" DIFFERENCE SCHEME;
    "BEGIN" "INTEGER" I;"REAL" MLT;
 
        DER(T,U,DU);
        "FOR" I:=1 "STEP" 1 "UNTIL" 8 "DO"
        "BEGIN" MLT:=LAMBDA[I]*TAU;
           DUPMAT(1,N,1,M,UH,U);
           ELMMAT(UH,DU,MLT);
           DER(T+MLT,UH,DU)
        "END";
        ELMMAT(U,DU,TAU);
        T:="IF" LAST "THEN" TE "ELSE" T+TAU;
     "END" DIFFERENCE SCHEME;
 
     INITIALIZE; LAST:="FALSE";
 
     STEP:
     TAU:=("IF" SPR=0 "THEN" ABS(TE-T) "ELSE" ABS(LAMBDA[9]/SPR))*SIG;
     "IF" T+TAU >= TE "EQV" TAU>=0 "THEN"
     "BEGIN" TAU:=TE-T;LAST:="TRUE" "END";
     DIFFERENCE SCHEME ; OUT;
     "IF" "NOT" LAST "THEN" "GOTO" STEP
 
 "END" ARKMAT;
         "EOP"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 1
 
 
 
 AUTHOR: M. BAKKER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 751231/ REVISED 791231.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THREE PROCEDURES FOR THE SOLUTION
     OF SECOND ORDER SELF-ADJOINT LINEAR TWO POINT
     BOUNDARY VALUE PROBLEMS;
 
     (1) FEM LAG SYM;
 
     THIS PROCEDURE SOLVES THE DIFFERENTIAL EQUATION
 
            - (P(X)*Y')' + R(X)*Y = F(X), A < X < B,
 
       WITH BOUNDARY CONDITIONS
 
           E[1]*Y(A) + E[2]*Y'(A) = E[3],
 
           E[4]*Y(B) + E[5]*Y'(B) = E[6].
 
     (2) FEM LAG;
 
     THIS PROCEDURE SOLVES THE DIFFERENTIAL EQUATION
 
                   - Y'' + R(X)*Y = F(X), A < X < B,
 
       WITH BOUNDARY CONDITIONS
 
           E[1]*Y(A) + E[2]*Y'(A) = E[3],
 
           E[4]*Y(B) + E[5]*Y'(B) = E[6].
 
     (3) FEM LAG SPHER:
 
     THIS PROCEDURE SOLVES THE DIFFERENTIAL EQUATION
 
       WITH SPHERICAL COORDINATES
 
            - (X**NC*Y')'/X**NC + R(X)*Y = F(X),  A < X < B,
 
       WITH BOUNDARY CONDITIONS
 
           E[1]*Y(A) + E[2]*Y'(A) = E[3],
 
           E[4]*Y(B) + E[5]*Y'(B) = E[6].
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 2
 
 
 
 KEY WORDS AND PHRASES:
 
     SECOND ORDER DIFFERENTIAL EQUATIONS,
     TWO POINT BOUNDARY VALUE PROBLEMS,
     SELF-ADJOINT BOUNDARY VALUE PROBLEMS,
     RITZ-GALERKIN METHOD,
     SPHERICAL COORDINATES,
     GLOBAL METHODS.
 
 
 LANGUAGE: ALGOL 60.
 
 
 REFERENCES:
 
     [1]  STRANG, G. AND G.J. FIX,
          AN ANALYSIS OF THE FINITE ELEMENT METHOD,
          PRENTICE-HALL, ENGLEWOOD CLIFFS, NEW JERSEY, 1973.
 
     [2]  BAKKER, M., EDITOR,
          COLLOQUIUM ON DISCRETIZATION METHODS, CHAPTER 3 (DUTCH),
          MATHEMATISCH CENTRUM, MC-SYLLABUS, 1976.
 
     [3]  HEMKER, P.W.,
          GALERKIN'S METHOD AND LOBATTO POINTS,
          MATHEMATISCH CENTRUM, REPORT 24/75 (1975).
 
     [4]  BABUSKA, I.,
          NUMERICAL STABILITY IN PROBLEMS OF LINEAR ALGEBRA,
          S.I.A.M.  J. NUM. ANAL., VOL.9, P. 53-77 (1972).
 
 
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 3
 
 
 
 SUBSECTION: FEM LAG SYM.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" FEM LAG SYM(X, Y, N, P, R, F, ORDER, E);
     "VALUE" N, ORDER; "INTEGER" N, ORDER;
     "ARRAY" X, Y, E;
     "REAL" "PROCEDURE" P, R, F;
     "CODE" 33300;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1;
 
     X:  <ARRAY IDENTIFIER>;
         "ARRAY" X[0:N];
         ENTRY: A = X[0] < X[1] < ... < X[N] = B
         IS A PARTITION OF THE INTERVAL [A,B];
 
     Y:  <ARRAY IDENTIFIER>;
         "ARRAY" Y[0:N];
         EXIT: Y[I] (I = 0, 1, ... , N) IS THE APPROXIMATE
         SOLUTION AT X[I] OF THE DIFFERENTIAL EQUATION
 
         (1)      - (P(X)*Y')' + R(X)*Y = F(X), A < X < B,
 
         WITH BOUNDARY CONDITIONS
 
                E[1]*Y(A) + E[2]*Y'(A) = E[3],
         (2)
                E[4]*Y(B) + E[5]*Y'(B) = E[6];
 
 
     P:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF P READS:
         "REAL" "PROCEDURE" P(X); "VALUE" X; "REAL" X;
         P(X) IS THE COEFFICIENT OF Y' IN (1);
 
     R:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF R READS:
         "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
         R(X) IS THE COEFFICIENT OF Y IN (1);
 
     F:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF F READS:
         "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
         F(X) IS THE RIGHT HAND SIDE OF (1);
 
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 4
 
 
 
     ORDER: <ARITHMETIC EXPRESSION>;
         ENTRY: ORDER DENOTES THE ORDER OF ACCURACY REQUIRED FOR THE
         APPROXIMATE SOLUTION OF (1)-(2); LET H = MAX(X[I] - X[I-1]);
         THEN  ABS(Y[I] - Y(X[I])) <= C*H**ORDER, I = 0, ... , N;
         ORDER CAN BE CHOSEN EQUAL TO 2, 4 OR 6 ONLY;
 
     E:  <ARRAY IDENTIFIER>;
         "ARRAY" E[1:6];
         E[1], ... , E[6] DESCRIBE THE BOUNDARY CONDITIONS (2);
         E[1] AND E[4] ARE NOT ALLOWED TO VANISH BOTH.
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
     FOUR AUXILIARY ARRAYS OF N REALS ARE USED.
 
 
 RUNNING TIME:
 
     LET K = ORDER/2; THEN
     (A)   K*N + 1 EVALUATIONS OF P(X), R(X) AND F(X) ARE NEEDED;
     (B)   ABOUT 17*2**(K-1)*N MULTIPLICATIONS/DIVISIONS ARE NEEDED.
 
 
 DATA AND RESULTS:
 
     THE PROCEDURE FEM LAG SYM HAS SOME RESTRICTIONS IN ITS USE:
     (I) P(X) SHOULD BE POSITIVE ON THE CLOSED INTERVAL <X[J-1],X[J]>;
     (II) P(X), R(X) AND F(X) ARE REQUIRED TO BE SUFFICIENTLY SMOOTH
       ON <X[0],X[N]> EXCEPT AT THE GRID POINTS WHERE P(X) SHOULD BE
       AT LEAST CONTINUOUS;
       IN THAT CASE THE ORDER OF ACCURACY (2, 4, OR 6) IS PRESERVED;
     (III) R(X) SHOULD BE NONNEGATIVE ON <X[0],X[N]>;
       IF, HOWEVER, THE PROBLEM HAS PURE DIRICHLET BOUNDARY CONDITIONS
       (I.E. E[2] = E[5] = 0) THIS CONDITION CAN BE WEAKENED TO THE
       REQUIREMENT THAT
 
             R(X) > - P0*(PI/(X[N] - X[0]))**2,
 
       WHERE P0 IS THE MINIMUM OF P(X) ON <X[0],X[N]> AND PI HAS
       THE VALUE 3.14159...; HOWEVER, ONE SHOULD NOTE THAT THE
       PROBLEM MAY BE ILL-CONDITIONED WHEN R(X) IS QUITE NEAR THAT
       LOWER BOUND; FOR OTHER NEGATIVE VALUES OF R(X) THE EXISTENCE
       OF A SOLUTION REMAINS AN OPEN QUESTION;
     (IV) THE USER SHOULD NOT EXPECT GREATER ACCURACY THAN 12 DECIMALS
       DUE TO THE LOSS OF DIGITS DURING THE EVALUATION OF THE MATRIX
       AND THE VECTOR OF THE LINEAR SYSTEM TO BE SOLVED AND DURING ITS
       REDUCTION TO A TRIDIAGONAL SYSTEM; WHEN THE SOLUTION OF THE
       PROBLEM IS NOT TOO WILD, THIS 12-DIGIT ACCURACY CAN ALREADY BE
       OBTAINED WITH A MODERATE MESH SIZE (E.G. < 0.1), PROVIDED THAT
       A SIXTH ORDER METHOD IS USED.
 
 
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 5
 
 
 
 METHOD AND PERFORMANCE:
 
     PROBLEM (1)-(2) IS SOLVED BY MEANS OF GALERKIN'S METHOD WITH
     CONTINUOUS PIECEWISE POLYNOMIALS (SEE [1], [2]);
     THE SOLUTION IS APPROXIMATED BY A FUNCTION WHICH IS CONTINUOUS ON
     THE CLOSED INTERVAL <X[0],X[N]> AND A POLYNOMIAL OF DEGREE LESS
     THAN OR EQUAL TO K (K = ORDER//2) ON EACH SEGMENT <X[J-1],X[J]>
     (J = 1, ..., N); THIS  PIECEWISE POLYNOMIAL IS ENTIRELY
     DETERMINED BY THE VALUES IT HAS
     AT THE KNOTS X[J] AND ON (K-1) INTERIOR KNOTS ON EACH SEGMENT
     <X[J-1],X[J]>; THESE VALUES ARE OBTAINED BY THE SOLUTION OF AN
     (ORDER + 1)-DIAGONAL LINEAR SYSTEM WITH A SPECIALLY STRUCTURED
     MATRIX (SEE [2]); THE ENTRIES OF THE MATRIX AND THE VECTOR ARE
     INNER PRODUCTS WHICH ARE APPROXIMATED BY PIECEWISE (K+1)-POINT
     LOBATTO QUADRATURE (SEE [3]); THE EVALUATION OF THE MATRIX AND
     THE VECTOR IS DONE SEGMENT BY SEGMENT: ON EACH SEGMENT
     THE CONTRIBUTIONS TO THE ENTRIES OF THE MATRIX AND THE
     VECTOR ARE COMPUTED AND EMBEDDED IN THE GLOBAL MATRIX AND
     VECTOR; SINCE THE FUNCTION VALUES ON THE INTERIOR
     POINTS OF EACH SEGMENT ARE NOT COUPLED WITH THE FUNCTION
     VALUES OUTSIDE THAT SEGMENT, THE RESULTING LINEAR SYSTEM
     CAN BE REDUCED TO A TRIDIAGONAL SYSTEM BY MEANS OF STATIC
     CONDENSATION (SEE [2]); THE FINAL TRIDIAGONAL SYSTEM,
     SINCE IT IS OF FINITE DIFFERENCE TYPE, IS SOLVED BY
     MEANS OF BABUSKA'S METHOD (SEE [4]).
 
 
 EXAMPLE OF USE:
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
 
     -(Y'*EXP(X))'+Y*COS(X)=EXP(X)*(SIN(X)-COS(X))+SIN(2*X)/2,
     0 < X < PI = 3.14159265358979,
     Y(0) = Y(PI) = 0;
 
     FOR THE BOUNDARY CONDITIONS THIS MEANS THAT
 
         E[1] = E[4] = 1; E[2] = E[3] = E[5] = E[6] = 0;
 
     THE ANALYTIC SOLUTION IS Y(X) = SIN(X); WE APPROXIMATE
     THE SOLUTION ON A UNIFORM GRID, I.E. X[I] = I*PI/N,
     I = 0, ..., N; WE CHOOSE N=10,20 AND COMPUTE FOR ORDER = 2,4,6
     THE MAXIMUM ERROR; THE PROGRAM READS AS FOLLOWS:
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 6
 
 
 
     "BEGIN" "INTEGER" N; "FOR" N:= 10, 20 "DO"
     "BEGIN" "INTEGER" I, ORDER; "REAL" PI; "ARRAY" X, Y[0:N], E[1:6];
 
         "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
         R:= COS(X);
 
         "REAL" "PROCEDURE" P(X); "VALUE" X; "REAL" X;
         P:= EXP(X);
 
         "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
         F:= EXP(X)*(SIN(X)-COS(X)) + SIN(2*X)/2;
 
         E[1]:= E[4]:= 1; E[2]:= E[3]:= E[5]:= E[6]:= 0;
         PI:= 3.14159265358979;
         "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= PI*I/N;
         OUTPUT(61,"("//,6B"("N=")"ZD")",N);
         "FOR" ORDER:= 2, 4, 6 "DO"
         "BEGIN" "REAL" RHO, D;
             FEM LAG SYM(X, Y, N, P, R, F, ORDER, E);
             RHO:= 0;
             "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO"
             "BEGIN" D:= ABS(Y[I] - SIN(X[I]));
                 "IF" RHO < D "THEN" RHO:= D
             "END";
             OUTPUT(61,"("/,16B"("ORDER=")"D,4B"("MAX.ERROR= ")",
             D.DD"+ZD")",ORDER,RHO)
         "END"
     "END"
     "END"
 
     RESULTS:
 
     N=10
               ORDER=2  MAX. ERROR= 1.36" -2
               ORDER=4  MAX. ERROR= 7.55" -5
               ORDER=6  MAX. ERROR= 3.48" -8
 
     N=20
               ORDER=2  MAX. ERROR= 3.41" -3
               ORDER=4  MAX. ERROR= 4.79" -6
               ORDER=6  MAX. ERROR= 5.51"-10
 
     ONE OBSERVES THAT THE MAXIMUM ERROR DECREASES BY ABOUT
     2**(-ORDER)  WHEN THE MESH SIZE IS HALVED.
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 7
 
 
 
 SUBSECTION: FEM LAG.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" FEM LAG(X, Y, N, R, F, ORDER, E);
     "VALUE" N, ORDER; "INTEGER" N, ORDER;
     "ARRAY" X, Y, E;
     "REAL" "PROCEDURE" R, F;
     "CODE" 33301;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1;
 
     X:  <ARRAY IDENTIFIER>;
         "ARRAY" X[0:N];
         ENTRY: A = X[0] < X[1] < ... < X[N] = B IS  A
         PARTITION OF THE SEGMENT [A,B];
 
     Y:  <ARRAY IDENTIFIER>;
         "ARRAY" Y[0:N];
         EXIT: Y[I] (I = 0, 1, ... , N) IS THE APPROXIMATE
         SOLUTION AT X[I] OF THE DIFFERENTIAL EQUATION
 
         (3)  - Y''+ R(X)*Y = F(X), A < X < B,
 
         WITH BOUNDARY CONDITIONS
         (4)    E[1]*Y(A) + E[2]*Y'(A) = E[3],
                E[4]*Y(B) + E[5]*Y'(B) = E[6];
 
     R:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF R READS:
         "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
         R(X) IS THE COEFFICIENT OF Y IN (3);
 
     F:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF F READS:
         "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
         F(X) IS THE RIGHT HAND SIDE OF (3);
 
     ORDER: <ARITHMETIC <EXPRESSION>;
         ENTRY: ORDER DENOTES THE ORDER OF ACCURACY REQUIRED FOR THE
         APPROXIMATE SOLUTION OF (3)-(4); LET H = MAX(X[I] - X[I-1]);
         THEN  ABS(Y[I] - Y(X[I])) <= C*H**ORDER, I = 0, ... , N;
         ORDER CAN CAN BE CHOSEN EQUAL TO 2, 4 OR 6 ONLY;
 
     E:  <ARRAY IDENTIFIER>;
         "ARRAY" E[1:6];
         E[1], ... , E[6] DESCRIBE THE BOUNDARY CONDITIONS (4);
         E[1] AND E[4] ARE NOT ALLOWED TO VANISH BOTH.
 
 
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 8
 
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
 
     FOUR AUXILIARY ARRAYS OF N REALS ARE USED.
 
 
 RUNNING TIME:
 
     LET K = ORDER/2; THEN
 
     (A)   K*N + 1 EVALUATIONS OF R(X) AND F(X) ARE NEEDED;
 
     (B)   ABOUT 12*2**(K-1)*N MULTIPLICATIONS/DIVISIONS ARE NEEDED.
 
 
 DATA AND RESULTS: SEE PREVIOUS SUBSECTION.
 
 
 METHOD AND PERFORMANCE: SEE PREVIOUS SUBSECTION.
 
 
 EXAMPLE OF USE:
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
 
         - Y'' + Y*EXP(X) = SIN(X)*(1+EXP(X),
         0 < X < PI = 3.14159265358979,
         Y(0) = Y(PI) = 0;
 
     FOR THE BOUNDARY CONDITIONS THIS MEANS THAT
 
         E[1] = E[4] = 1; E[2] = E[3] = E[5] = E[6] = 0;
 
     THE ANALYTIC SOLUTION IS Y(X) = SIN(X); WE APPROXIMATE
     THE SOLUTION ON A UNIFORM GRID, I.E. X[I] = I*PI/N,
     I = 0, ..., N; WE CHOOSE N=10,20 AND COMPUTE FOR ORDER = 2,4,6
     THE MAXIMUM ERROR; THE PROGRAM READS AS FOLLOWS:
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                     PAGE 9
 
 
 
     "BEGIN" "INTEGER" N; "FOR" N:= 10, 20 "DO"
     "BEGIN" "INTEGER" I, ORDER; "REAL" PI; "ARRAY" X, Y[0:N], E[1:6];
 
         "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
         R:= EXP(X);
 
         "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
         F:= SIN(X)*(1 + EXP(X));
 
         E[1]:= E[4]:= 1; E[2]:= E[3]:= E[5]:= E[6]:= 0;
         PI:= 3.14159265358979;
         "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= PI*I/N;
         OUTPUT(61,"("//,6B"("N=")"ZD")",N);
         "FOR" ORDER:= 2, 4, 6 "DO"
         "BEGIN" "REAL" RHO, D;
             FEM LAG(X, Y, N, R, F, ORDER, E);
             RHO:= 0;
             "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO"
             "BEGIN" D:= ABS(Y[I] - SIN(X[I]));
                 "IF" RHO < D "THEN" RHO:= D
             "END";
             OUTPUT(61,"("/,16B"("ORDER=")"D,4B"("MAX.ERROR= ")",
             D.DD"+ZD")",ORDER,RHO)
         "END"
     "END"
     "END"
 
     RESULTS:
 
     N=10
               ORDER=2    MAX. ERROR= 1.60" -3
               ORDER=4    MAX. ERROR= 1.55" -5
               ORDER=6    MAX. ERROR= 7.28"-10
 
 
     N=20
               ORDER=2    MAX. ERROR= 4.01" -4
               ORDER=4    MAX. ERROR= 9.80" -7
               ORDER=6    MAX. ERROR= 9.38"-12
 
     NOTICE THAT THE MAXIMUM ERROR DECREASES BY ABOUT
     2**(-ORDER) WHEN THE MESH SIZE IS HALVED.
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 10
 
 
 
 
 SUBSECTION: FEM LAG SPHER.
 
 
 CALLING SEQUENCE:
 
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" FEM LAG SPHER(X, Y, N, NC, R, F, ORDER, E);
     "VALUE" N, NC, ORDER; "INTEGER" N, NC, ORDER;
     "ARRAY" X, Y, E;
     "REAL" "PROCEDURE" R, F;
     "CODE" 33308;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1;
 
     NC:   <EXPRESSION>;
          IF NC = 0, CARTESIAN COORDINATES ARE USED;
          IF NC = 1, POLAR COORDINATES ARE USED;
          IF NC = 2, SPHERICAL COORDINATES ARE USED;
 
     X:  <ARRAY IDENTIFIER>;
         "ARRAY" X[0:N];
         ENTRY: A = X[0] < X[1] < ... < X[N] = B IS  A
         PARTITION OF THE INTERVAL [A,B];
 
     Y:  <ARRAY IDENTIFIER>;
         "ARRAY" Y[0:N];
         EXIT: Y[I] (I = 0, 1, ... , N) IS THE APPROXIMATE
         SOLUTION AT X[I] OF THE DIFFERENTIAL EQUATION
 
         (1)      - (X**NC*Y')'/X**NC + R(X)*Y = F(X), A < X < B,
 
         WITH BOUNDARY CONDITIONS
 
                E[1]*Y(A) + E[2]*Y'(A) = E[3],
         (2)
                E[4]*Y(B) + E[5]*Y'(B) = E[6];
 
 
     R:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF R READS:
         "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
         R(X) IS THE COEFFICIENT OF Y IN (1);
 
     F:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF F READS:
         "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
         F(X) IS THE RIGHT HAND SIDE OF (1);
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 11
 
 
     ORDER: <ARITHMETIC EXPRESSION>;
         ENTRY: ORDER DENOTES THE ORDER OF ACCURACY REQUIRED FOR THE
         APPROXIMATE SOLUTION OF (1)-(2); LET H = MAX(X[I] - X[I-1]);
         THEN  ABS(Y[I] - Y(X[I])) <= C*H**ORDER, I = 0, ... , N;
         ORDER CAN BE CHOSEN EQUAL TO 2 OR 4 ONLY;
 
     E:  <ARRAY IDENTIFIER>;
         "ARRAY" E[1:6];
         E[1], ... , E[6] DESCRIBE THE BOUNDARY CONDITIONS (2);
         E[1] AND E[4] ARE NOT ALLOWED TO VANISH BOTH.
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
 
     FOUR AUXILIARY ARRAYS OF N REALS ARE USED.
 
 
 RUNNING TIME:
 
     LET K = ORDER/2; THEN
     (A)   K*N EVALUATIONS OF R(X) AND F(X) ARE NEEDED;
     (B)   IF NC > 0 AND ORDER=4, THEN N SQUARE ROOTS ARE EVALUATED;
 
 
  DATA AND RESULTS:
 
     THE PROCEDURE FEM LAG SPHER HAS SOME RESTRICTIONS IN ITS USE:
     R(X) AND F(X) ARE REQUIRED TO BE SUFFICIENTLY SMOOTH
     ON <X[0],X[N]> EXCEPT AT THE GRID POINTS; FURTHERMORE R(X)
     SHOULD BE NONNEGATIVE.
 
 
  METHOD AND PERFORMANCE:
 
     PROBLEM (1)-(2) IS SOLVED BY MEANS OF GALERKIN'S METHOD WITH
     CONTINUOUS PIECEWISE POLYNOMIALS (SEE [1], [2]);
     THE SOLUTION IS APPROXIMATED BY A FUNCTION WHICH IS CONTINUOUS ON
     THE CLOSED INTERVAL <X[0],X[N]> AND A POLYNOMIAL OF DEGREE LESS
     THAN OR EQUAL TO K (K = ORDER//2) ON EACH SEGMENT <X[J-1],X[J]>
     (J = 1, ..., N); THIS  PIECEWISE POLYNOMIAL IS ENTIRELY
     DETERMINED BY THE VALUES IT HAS
     AT THE KNOTS X[J] AND ON (K-1) INTERIOR KNOTS ON EACH SEGMENT
     <X[J-1],X[J]>; THESE VALUES ARE OBTAINED BY THE SOLUTION OF AN
     (ORDER + 1)-DIAGONAL LINEAR SYSTEM WITH A SPECIALLY STRUCTURED
     MATRIX (SEE [2]); THE ENTRIES OF THE MATRIX AND THE VECTOR ARE
     INNER PRODUCTS WHICH ARE APPROXIMATED BY SOME PIECEWISE K-POINT
     GAUSSIAN QUADRATURE (SEE [4]); THE EVALUATION OF THE MATRIX AND
     THE VECTOR IS DONE SEGMENT BY SEGMENT: ON EACH SEGMENT
     THE CONTRIBUTIONS TO THE ENTRIES OF THE MATRIX AND THE VECTOR
     ARE COMPUTED AND EMBEDDED IN THE GLOBAL MATRIX AND VECTOR;
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 12
 
 
 
     SINCE THE FUNCTION VALUES ON THE INTERIOR
     POINTS OF EACH SEGMENT ARE NOT COUPLED WITH THE FUNCTION
     VALUES OUTSIDE THAT SEGMENT, THE RESULTING LINEAR SYSTEM
     CAN BE REDUCED TO A TRIDIAGONAL SYSTEM BY MEANS OF STATIC
     CONDENSATION (SEE [2]); THE FINAL TRIDIAGONAL SYSTEM,
     SINCE IT IS OF FINITE DIFFERENCE TYPE, IS SOLVED BY
     MEANS OF BABUSKA'S METHOD (SEE [3]).
 
 
 EXAMPLE OF USE:
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
 
     -(Y'*X**NC)'/X**NC + Y = 1 - X**4 + (12 + 4*NC)*X**2,
         0 < X < 1; Y'(0) = Y(1) = 0;
 
     FOR THE BOUNDARY CONDITIONS THIS IMPLIES THAT
 
         E[2] = E[4] = 1; E[1] = E[3] = E[5] = E[6] = 0;
 
     THE ANALYTIC SOLUTION IS Y(X) = 1 - X**4; WE APPROXIMATE
     THE SOLUTION ON A UNIFORM GRID, I.E. X[I] = I/N,  I = 0, ..., N;
     I = 0, ..., N; WE CHOOSE N=10,20 AND COMPUTE FOR ORDER = 2,4
     THE MAXIMUM ERROR; THE PROGRAM READS AS FOLLOWS:
 
     "BEGIN" "INTEGER" N, NC;
         "FOR" N:= 10, 20 "DO" "FOR" NC:= 0, 1, 2 "DO"
     "BEGIN" "INTEGER" I, ORDER; "ARRAY" X, Y[0:N], E[1:6];
 
         "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
         R:= 1;
 
         "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
         F:= (12 + 4*NC)*X**2 + 1 - X**4;
 
         E[2]:= E[4]:= 1; E[1]:= E[3]:= E[5]:= E[6]:= 0;
         "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= I/N;
         OUTPUT(61,"("//,6B"("N=")"ZZD,6B"("NC=")"ZD")",N,NC);
         "FOR" ORDER:= 2, 4 "DO"
         "BEGIN" "REAL" RHO, D;
             FEM LAG SPHER(X, Y, N, NC, R, F, ORDER, E);
             RHO:= 0;
             "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO"
             "BEGIN" D:= ABS(Y[I] - 1 + X[I]**4);
                 "IF" RHO < D "THEN" RHO:= D
             "END";
             OUTPUT(61,"("/,16B"(" ORDER=")"ZD,4B"("MAX.ERROR= ")",
             D.DD"+ZD")",ORDER,RHO)
         "END"
     "END"
     "END"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 13
 
 
 
     RESULTS:
 
     N= 10      NC= 0
                ORDER= 2    MAX.ERROR= 4.37" -3
                ORDER= 4    MAX.ERROR= 2.93" -6
 
     N= 10      NC= 1
                ORDER= 2    MAX.ERROR= 1.42" -2
                ORDER= 4    MAX.ERROR= 5.49" -5
 
     N= 10      NC= 2
                ORDER= 2    MAX.ERROR= 2.46" -2
                ORDER= 4    MAX.ERROR= 1.27" -4
 
     N= 20      NC= 0
                ORDER= 2    MAX.ERROR= 1.09" -3
                ORDER= 4    MAX.ERROR= 1.83" -7
 
     N= 20      NC= 1
                ORDER= 2    MAX.ERROR= 3.53" -3
                ORDER= 4    MAX.ERROR= 3.91" -6
 
     N= 20      NC= 2
                ORDER= 2    MAX.ERROR= 6.10" -3
                ORDER= 4    MAX.ERROR= 9.26" -6
 
     ONE OBSERVES THAT THE MAXIMUM ERROR DECREASES BY ABOUT
     2**(-ORDER)  WHEN THE MESH SIZE IS HALVED.
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 14
 
 
 
  SOURCE TEXT(S):
0"CODE" 33300;
  "PROCEDURE" FEM LAG SYM(X, Y, N, P, R, F, ORDER, E);
  "VALUE" N, ORDER; "INTEGER" N, ORDER;
  "REAL" "PROCEDURE" P, R, F;
  "ARRAY" X, Y, E;
  "BEGIN" "INTEGER" L, L1;
    "REAL" XL1, XL, H, A12, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP,
      P1, P2, P3, P4, R1, R2, R3, R4, F1, F2, F3, F4,
      E1, E2, E3, E4, E5, E6;
    "ARRAY" T, SUB, CHI, GI[0:N-1];
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 1;
    "BEGIN" "REAL"  H2;
      "IF" L=1 "THEN"
      "BEGIN" P2:= P(XL1); R2:= R(XL1); F2:= F(XL1) "END";
      P1:= P2; P2:= P(XL); R1:= R2; R2:= R(XL); F1:= F2; F2:= F(XL);
      H2:= H/2; B1:= H2*F1; B2:= H2*F2; TAU1:= H2*R1; TAU2:= H2*R2;
      A12:= -0.5*(P1 + P2)/H
    "END" ELAN. M.V. EV.;
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 2;
    "BEGIN" "REAL"  X2, H6, H15, B3, TAU3, C12, C32, A13, A22, A23;
      "IF" L=1 "THEN"
      "BEGIN" P3:= P(XL1); R3:= R(XL1); F3:= F(XL1) "END";
      X2:= (XL1 + XL)/2; H6:= H/6; H15:= H/1.5;
      P1:= P3; P2:= P(X2); P3:= P(XL);
      R1:= R3; R2:= R(X2); R3:= R(XL);
      F1:= F3; F2:= F(X2); F3:= F(XL);
      B1:= H6*F1; B2:= H15*F2; B3:= H6*F3;
      TAU1:= H6*R1; TAU2:= H15*R2; TAU3:= H6*R3;
      A12:= -(2*P1 + P3/1.5)/H; A13:= (0.5*(P1 + P3) - P2/1.5)/H;
      A22:= (P1 + P3)/H/0.375 + TAU2; A23:= -(P1/3 + P3)*2/H;
      "COMMENT" STATIC CONDENSATION;
      C12:= - A12/A22; C32:= - A23/A22; A12:= A13 + C32*A12;
      B1:= B1 + C12*B2; B2:= B3 + C32*B2;
      TAU1:= TAU1 + C12*TAU2; TAU2:= TAU3 + C32*TAU2
    "END" ELEMENT MAT VEC EVALUATION 2;
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 3;
    "BEGIN" "REAL"  X2, X3, H12, H24, DET, C12, C13, C42, C43,
      A13, A14, A22, A23, A24, A33, A34, B3, B4, TAU3, TAU4;
      "IF" L=1 "THEN"
      "BEGIN" P4:= P(XL1); R4:= R(XL1); F4:= F(XL1) "END";
      X2:= XL1 + 0.27639320225*H; X3:= XL - X2 + XL1;
      H12:= H/12; H24:= H/2.4;
      P1:= P4; P2:= P(X2); P3:= P(X3); P4:= P(XL);
      R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL);
      F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL);
      B1:= H12*F1; B2:= H24*F2; B3:= H24*F3; B4:= H12*F4;
      TAU1:= H12*R1; TAU2:= H24*R2; TAU3:= H24*R3; TAU4:= H12*R4;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 15
                                                               ;
 
 
      A12:= -(+ 4.04508497187450*P1
              + 0.57581917135425*P3
              + 0.25751416197911*P4)/H;
      A13:= (+ 1.5450849718747*P1
             - 1.5075141619791*P2
             + 0.6741808286458*P4)/H;
      A14:= ((P2 + P3)/2.4 - (P1 + P4)/2)/H;
      A22:= (5.454237476562*P1 + P3/.48 +.79576252343762*P4)/H + TAU2;
      A23:= - (P1 + P4)/(H*0.48);
      A24:= (+ 0.67418082864575*P1
             - 1.50751416197910*P3
             + 1.54508497187470*P4)/H;
      A33:= (.7957625234376*P1 + P2/.48 + 5.454237476562*P4)/H + TAU3;
      A34:= -(+ 0.25751416197911*P1
              + 0.57581917135418*P2
              + 4.0450849718747*P4)/H;
      "COMMENT" STATIC CONDENSATION;
      DET:= A22*A33 - A23*A23;
      C12:= (A13*A23 - A12*A33)/DET;
      C13:= (A12*A23 - A13*A22)/DET;
      C42:= (A23*A34 - A24*A33)/DET;
      C43:= (A24*A23 - A34*A22)/DET;
      TAU1:= TAU1 + C12*TAU2 + C13*TAU3;
      TAU2:= TAU4 + C42*TAU2 + C43*TAU3;
      A12:= A14 + C42*A12 + C43*A13;
      B1:= B1 + C12*B2 + C13*B3;
      B2:= B4 + C42*B2 + C43*B3
    "END" ELEMENT MAT VEC EVALUATION 3;
 
    "PROCEDURE" BOUNDARY CONDITIONS;
    "IF" L=1 "AND" E2 = 0 "THEN"
    "BEGIN"  TAU1:= 1; B1:= E3/E1;B2:= B2 - A12*B1;
      TAU2:= TAU2 - A12; A12:= 0 "END"
    "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN"
    "BEGIN" "REAL" AUX; AUX:= P1/E2; TAU1:= TAU1 - AUX*E1 ;
      B1:= B1 - E3*AUX
    "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN"
    "BEGIN" TAU2:= 1; B2:= E6/E4;
      B1:= B1 - A12*B2; TAU1:= TAU1 - A12; A12:= 0
    "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN"
    "BEGIN" "REAL" AUX; AUX:= P2/E5;
      TAU2:= TAU2 + AUX*E4; B2:= B2 + AUX*E6
    "END" B.C.1;
 
    "PROCEDURE" FORWARD BABUSHKA;
    "IF" L=1 "THEN"
    "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL;
       GI[0]:=  G:= YL:=   B1; Y[0]:= YL;
      SUB[0]:= A12; PP:= A12/(CH - A12);
      CH:= TAU2 - CH*PP; G:= B2 - G*PP; TL:= TAU2; YL:= B2
    "END" "ELSE"
    "BEGIN" CHI[L1]:= CH:= CH + TAU1;
       GI[L1]:=  G:=  G + B1;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 16
                                                               ;
 
 
      SUB[L1]:= A12; PP:= A12/(CH - A12);
      CH:= TAU2 - CH*PP; G:= B2 - G*PP;
      T[L1]:= TL + TAU1; TL:= TAU2;
      Y[L1]:= YL +   B1; YL:=   B2
    "END" FORWARD BABUSHKA 1;
 
    "PROCEDURE" BACKWARD BABUSHKA;
    "BEGIN" PP:= YL; Y[N]:= G/CH;
      G:= PP; CH:= TL; L:= N;
      "FOR" L:= L - 1 "WHILE" L >= 0 "DO"
      "BEGIN" PP:= SUB[L]; PP:= PP/(CH - PP);
          TL:= T[L]; CH:= TL - CH*PP;
          YL:= Y[L]; G:= YL - G*PP;
          Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL)
      "END"
    "END" BACKWARD BABUSHKA;
 
    L:= 0; XL:= X[0];
    E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6];
    "FOR" L:= L + 1 "WHILE" L <= N "DO"
    "BEGIN" L1:= L - 1; XL1:= XL; XL:= X[L]; H:= XL - XL1;
      "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE"
      "IF" ORDER = 4 "THEN" ELEMENT MAT VEC EVALUATION 2 "ELSE"
                            ELEMENT MAT VEC EVALUATION 3;
      "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS;
      FORWARD BABUSHKA
    "END";
    BACKWARD BABUSHKA;
  "END" FEM LAG SYM;
       "EOP"
 
0"CODE" 33301;
  "PROCEDURE" FEM LAG(X, Y, N, R, F, ORDER, E);
  "VALUE" N, ORDER; "INTEGER" N, ORDER;
  "REAL" "PROCEDURE" R, F;
  "ARRAY" X, Y, E;
  "BEGIN" "INTEGER" L, L1;
    "REAL" XL1, XL, H, A12, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP,
     E1, E2, E3, E4, E5, E6;
    "ARRAY" T, SUB, CHI, GI[0: N-1];
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 1;
    "BEGIN" "OWN" "REAL" F2, R2; "REAL" R1, F1, H2;
      "IF" L=1 "THEN"
      "BEGIN" F2:= F(XL1); R2:= R(XL1) "END";
      A12:= - 1/H; H2:= H/2;
      R1:= R2; R2:= R(XL); F1:= F2; F2:= F(XL);
      B1:= H2*F1; B2:= H2*F2; TAU1:= H2*R1; TAU2:= H2*R2
    "END" ELEMENT MAT VEC EVALUATION 1
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 17
                                                               ;
 
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 2;
     "BEGIN" "OWN" "REAL" R3, F3;
      "REAL" R1, R2, F1, F2, X2, H6, H15,
      B3, TAU3, C12, A13, A22, A23;
      "IF" L=1 "THEN"
      "BEGIN" R3:= R(XL1); F3:= F(XL1) "END";
      X2:= (XL1 + XL)/2; H6:= H/6; H15:= H/1.5;
      R1:= R3; R2:= R(X2); R3:= R(XL);
      F1:= F3; F2:= F(X2); F3:= F(XL);
      B1:= H6*F1; B2:= H15*F2; B3:= H6*F3;
      TAU1:= H6*R1; TAU2:= H15*R2; TAU3:= R3*H6;
      A12:= A23:= -8/H/3; A13:= - A12/8; A22:= -2*A12 + TAU2;
      "COMMENT" STATIC CONDENSATION;
      C12:= - A12/A22; A12:= A13 + C12*A12;
      B2:= C12*B2; B1:= B1 + B2; B2:= B3 + B2;
      TAU2:= C12*TAU2; TAU1:= TAU1 + TAU2; TAU2:= TAU3 + TAU2
    "END" ELEMENT MAT VEC EVALUATION2;
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 3;
    "BEGIN" "OWN" "REAL" R4, F4;
      "REAL" R1, R2, R3, F1, F2, F3, X2, X3, H12, H24,
      DET, C12, C13, C42, C43, A13, A14, A22, A23, A24,
      A33, A34, B3, B4, TAU3, TAU4;
      "IF" L=1 "THEN"
      "BEGIN" R4:= R(XL1); F4:= F(XL1) "END";
      X2:= XL1 + 0.27639320225*H; X3:= XL - X2 + XL1;
      R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL);
      F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL);
      H12:= H/12; H24:= H/2.4;
      B1:= F1*H12; B2:= F2*H24; B3:= F3*H24; B4:= F4*H12;
      TAU1:= R1*H12; TAU2:= R2*H24; TAU3:= R3*H24; TAU4:= R4*H12;
      A12:= A34:= -4.8784183052078/H; A13:= A24:= 0.7117516385412/H;
      A14:= -0.16666666666667/H; A23:= 25*A14;
      A22:= -2*A23 + TAU2; A33:= -2*A23 + TAU3;
      "COMMENT" STATIC CONDENSATION;
      DET:= A22*A33 - A23*A23;
      C12:= (A13*A23 - A12*A33)/DET;
      C13:= (A12*A23 - A13*A22)/DET;
      C42:= (A23*A34 - A24*A33)/DET;
      C43:= (A24*A23 - A34*A22)/DET;
      TAU1:= TAU1 + C12*TAU2 + C13*TAU3;
      TAU2:= TAU4 + C42*TAU2 + C43*TAU3;
      A12:= A14 + C42*A12 + C43*A13;
      B1:= B1 + C12*B2 + C13*B3;
      B2:= B4 + C42*B2 + C43*B3
    "END" ELEMENT MAT VEC EVALUATION3
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 18
                                                               ;
 
 
    "PROCEDURE" BOUNDARY CONDITIONS;
    "IF" L=1 "AND" E2 = 0 "THEN"
    "BEGIN" TAU1:= 1; B1:= E3/E1; B2:= B2 - A12*B1;
      TAU2:= TAU2 - A12; A12:= 0 "END"
    "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN"
    "BEGIN" TAU1:= TAU1 - E1/E2;
      B1:= B1 - E3/E2
    "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN"
    "BEGIN" TAU2:= 1; B2:= E6/E4; B1:= B1 - A12*B2;
      TAU1:= TAU1 - A12; A12:= 0
    "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN"
    "BEGIN" TAU2:= TAU2 + E4/E5;
      B2:= B2 + E6/E5
    "END" BOUNDARY CONDITIONS;
 
    "PROCEDURE" FORWARD BABUSHKA;
    "IF" L=1 "THEN"
    "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL;
      GI[0]:= G:= YL:= B1; Y[0]:= YL;
      SUB[0]:= A12; PP:= A12/(CH - A12); CH:= TAU2 - CH*PP;
      G:= B2 - G*PP; TL:= TAU2; YL:= B2
    "END" "ELSE"
    "BEGIN" CHI[L1]:= CH:= CH + TAU1;
      GI[L1]:= G:= G + B1; SUB[L1]:= A12; PP:= A12/(CH - A12);
      CH:= TAU2 - CH*PP; G:= B2 - G*PP;
      T[L1]:= TL + TAU1; TL:= TAU2;
      Y[L1]:= YL +   B1; YL:=   B2
    "END" FORWARD BABUSHKA 1;
 
    "PROCEDURE" BACKWARD BABUSHKA;
    "BEGIN" PP:= YL; Y[N]:= G/CH;
      G:= PP; CH:= TL; L:= N;
      "FOR" L:= L - 1 "WHILE" L >= 0 "DO"
      "BEGIN" PP:= SUB[L]; PP:= PP/(CH - PP);
          TL:= T[L]; CH:= TL - CH*PP;
          YL:= Y[L]; G:= YL - G*PP;
          Y[L]:=((GI[L] + G) - YL)/((CHI[L] + CH) - TL)
      "END"
    "END" BACKWARD BABUSHKA;
 
    L:= 0; XL:= X[0];
    E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6];
    "FOR" L:= L + 1 "WHILE" L <= N "DO"
    "BEGIN" L1:= L - 1; XL1:= XL; XL:= X[L]; H:= XL - XL1;
      "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE"
      "IF" ORDER = 4 "THEN" ELEMENT MAT VEC EVALUATION 2 "ELSE"
                            ELEMENT MAT VEC EVALUATION 3;
      "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS;
      FORWARD BABUSHKA
    "END";
    BACKWARD BABUSHKA;
  "END" FEM LAGR
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 19
 
 
                                                                  ;
       "EOP"
 "CODE" 33308;
  "PROCEDURE" FEM LAG SPHER(X, Y, N, NC, R, F, ORDER, E);
  "VALUE" N, NC, ORDER; "INTEGER" N, NC, ORDER;
  "REAL" "PROCEDURE" R, F;
  "ARRAY" X, Y, E;
  "BEGIN" "INTEGER" L, L1;
    "REAL" XL1, XL, H, A12, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP,
     TAU3, B3, A13, A22, A23, C32, C12,
      E1, E2, E3, E4, E5, E6;
    "ARRAY" T, SUB, CHI, GI[0:N-1];
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 1;
    "BEGIN" "REAL"  XM, VL, VR,WL, WR, PR, RM, FM, XL2, XLXR, XR2;
     "IF" NC = 0 "THEN" VL:= VR:= 0.5 "ELSE" "IF" NC = 1 "THEN"
     "BEGIN" VL:= (XL1*2 + XL)/6; VR:= (XL1 + XL*2)/6 "END" "ELSE"
     "BEGIN" XL2:= XL1*XL1/12; XLXR:=XL1*XL/6; XR2:=XL*XL/12;
      VL:= 3*XL2 + XLXR + XR2;
      VR:= 3*XR2 + XLXR + XL2
     "END";
 
     WL:= H*VL; WR:=H*VR; PR:= VR/(VL +VR);
     XM:= XL1 + H*PR; FM:= F(XM); RM:=R(XM);
     TAU1:= WL*RM; TAU2:=WR*RM;
     B1:= WL*FM; B2:= WR*FM; A12:= - (VL + VR)/H + H*(1 - PR)*PR*RM
    "END" ELEM. M.V. EV.;
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 2;
    "BEGIN" "REAL" XLM, XRM, VLM, VRM, WLM, WRM, FLM, FRM,
     RLM, RRM, PL1, PL2, PL3, PR1, PR2, PR3, QL1, QL2, QL3,
     RLMPL1, RLMPL2, RLMPL3, RRMPR1, RRMPR2, RRMPR3,
     VLMQL1, VLMQL2, VLMQL3, VRMQR1, VRMQR2, VRMQR3,
     QR1, QR2,QR3;
 
     "IF" NC = 0 "THEN"
     "BEGIN" XLM:=XL1 + H*0.2113248654052; XRM:= XL1 + XL - XLM;
      VLM:= VRM:= 0.5;
      PL1:= PR3:= 0.45534180126148; PL3:= PR1:= -0.12200846792815;
      PL2:= PR2:= 1 - PL1 - PL3;
      QL1:= - 2.15470053837925; QL3:= -0.15470053837925;
      QL2:= - QL1 - QL3; QR1:= - QL3; QR3:= - QL1; QR2:= - QL2;
     "END" "ELSE" "IF" NC = 1 "THEN"
     "BEGIN" "REAL" A, A2, A3, A4, B, B2, B3, B4, P4H,
      P2, P3, P4, AUX1, AUX2;
      A:= XL1; A2:= A*A; A3:= A*A2; A4:= A*A3;
      B:= XL; B2:= B*B; B3:= B*B2; B4:= B*B3;
      P2:= 10*(A2 + 4*A*B + B2); P3:= 6*(A3 + 4*(A2*B + A*B2) + B3);
      P4:= SQRT(6*(A4 + 10*(A*B3 + A3*B) + 28*A2*B2 + B4));
      P4H:= P4*H; XLM:= (P3 - P4H)/P2; XRM:= (P3 + P4H)/P2;
      AUX1:= (A + B)/4; AUX2:= H*(A2 + 7*A*B + B2)/6/P4;
      VLM:= AUX1 - AUX2; VRM:= AUX1 + AUX2;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 20
                                                                     ;
 
 
     "END" "ELSE"
     "BEGIN" "REAL" A, A2, A3, A4, A5, A6, A7, A8,
      B, B2, B3, B4, B5, B6, B7, B8, AB4, A2B3, A3B2, A4B,
      P4, P5, P8, P8H, AUX1, AUX2;
      A:= XL1; A2:= A*A; A3:= A*A2; A4:= A*A3; A5:= A*A4; A6:= A*A5;
        A7:= A*A6; A8:= A*A7;
      B:= XL; B2:= B*B; B3:= B*B2; B4:= B*B3; B5:= B*B4; B6:= B*B5;
        B7:= B*B6; B8:= B*B7;
      AB4:= A*B4; A2B3:= A2*B3; A3B2:= A3*B2; A4B:=A4*B;
      P4:= 15*(A4 + 4*(A3*B + A*B3) + 10*A2*B2 + B4);
      P5:= 10*(A5 + 4*(A4B + AB4) + 10*(A3B2 + A2B3) + B5);
      P8:= SQRT(10*(A8 + 10*(A7*B + A*B7) + 55*(A2*B6 + A6*B2)
          + 164*(A5*B3 +A3*B5) + 290*A4*B4 + B8));
      AUX1:= (A2 +A*B + B2)/6; P8H:= P8*H;
      AUX2:= (H*(A5 + 7*(A4B + AB4) + 28*(A3B2 + A2B3) + B5))/4.8/P8;
      XLM:= (P5 - P8H)/P4; XRM:= (P5 + P8H)/P4;
      VLM:= AUX1 - AUX2; VRM:= AUX1 + AUX2
     "END";
 
     "IF" NC > 0 "THEN"
     "BEGIN" "REAL" AUX, PLM, PRM;
      PLM:= (XLM - XL1)/H; PRM:= (XRM - XL1)/H;
      AUX:= 2*PLM - 1; PL1:= AUX*(PLM - 1); PL3:= AUX*PLM;
        PL2:= 1 - PL1 - PL3;
      AUX:= 2*PRM - 1; PR1:= AUX*(PRM - 1); PR3:= AUX*PRM;
        PR2:= 1 - PR1 - PR3;
      AUX:= 4*PLM; QL1:= AUX - 3; QL3:= AUX - 1; QL2:= - QL1 - QL3;
      AUX:= 4*PRM; QR1:= AUX - 3; QR3:= AUX - 1; QR2:= - QR1 - QR3;
     "END";
 
     WLM:= H*VLM; WRM:= H*VRM; VLM:= VLM/H; VRM:= VRM/H;
     FLM:= F(XLM)*WLM; FRM:= WRM*F(XRM);
     RLM:= R(XLM)*WLM; RRM:= WRM*R(XRM);
     TAU1:= PL1*RLM + PR1*RRM;
     TAU2:= PL2*RLM + PR2*RRM;
     TAU3:= PL3*RLM + PR3*RRM;
     B1:= PL1*FLM + PR1*FRM;
     B2:= PL2*FLM + PR2*FRM;
     B3:= PL3*FLM + PR3*FRM;
     VLMQL1:= QL1*VLM; VRMQR1:= QR1*VRM;
     VLMQL2:= QL2*VLM; VRMQR2:= QR2*VRM;
     VLMQL3:= QL3*VLM; VRMQR3:= QR3*VRM;
     RLMPL1:= RLM*PL1; RRMPR1:= RRM*PR1;
     RLMPL2:= RLM*PL2; RRMPR2:= RRM*PR2;
     RLMPL3:= RLM*PL3; RRMPR3:= RRM*PR3;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 21
                                                                     ;
 
 
     A12:= VLMQL1*QL2 + VRMQR1*QR2 + RLMPL1*PL2 + RRMPR1*PR2;
     A13:= VLMQL1*QL3 + VRMQR1*QR3 + RLMPL1*PL3 + RRMPR1*PR3;
     A22:= VLMQL2*QL2 + VRMQR2*QR2 + RLMPL2*PL2 + RRMPR2*PR2;
     A23:= VLMQL2*QL3 + VRMQR2*QR3 + RLMPL2*PL3 + RRMPR2*PR3;
     "COMMENT" STATIC CONDENSATION;
     C12:= - A12/A22; C32:= - A23/A22; A12:= A13 + C32*A12;
     B1:= B1 + C12*B2; B2:= B3 + C32*B2;
     TAU1:= TAU1 + C12*TAU2; TAU2:= TAU3 + C32*TAU2
    "END" ELEMENT MAT VEC EVALUATION 2;
 
    "PROCEDURE" BOUNDARY CONDITIONS;
    "IF" L=1 "AND" E2 = 0 "THEN"
    "BEGIN"  TAU1:= 1; B1:= E3/E1;B2:= B2 - A12*B1;
      TAU2:= TAU2 - A12; A12:= 0 "END"
    "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN"
    "BEGIN" "REAL" AUX;
      AUX:= ("IF" NC = 0 "THEN" 1 "ELSE" X[0]**NC)/E2;
      B1:= B1 - E3*AUX; TAU1:= TAU1 - E1*AUX
    "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN"
    "BEGIN" TAU2:= 1; B2:= E6/E4;
      B1:= B1 - A12*B2; TAU1:= TAU1 - A12; A12:= 0
    "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN"
    "BEGIN" "REAL" AUX;
      AUX:= ("IF" NC = 0 "THEN" 1 "ELSE" X[N]**NC)/E5;
      TAU2:= TAU2 + AUX*E4; B2:= B2 + AUX*E6
    "END" B.C.1;
 
    "PROCEDURE" FORWARD BABUSHKA;
    "IF" L=1 "THEN"
    "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL;
       GI[0]:=  G:= YL:=   B1; Y[0]:= YL;
      SUB[0]:= A12; PP:= A12/(CH - A12);
      CH:= TAU2 - CH*PP; G:= B2 - G*PP; TL:= TAU2; YL:= B2
    "END" "ELSE"
    "BEGIN" CHI[L1]:= CH:= CH + TAU1;
       GI[L1]:=  G:=  G + B1;
      SUB[L1]:= A12; PP:= A12/(CH - A12);
      CH:= TAU2 - CH*PP; G:= B2 - G*PP;
      T[L1]:= TL + TAU1; TL:= TAU2;
      Y[L1]:= YL +   B1; YL:=   B2
    "END" FORWARD BABUSHKA
1SECTION : 5.2.1.2.1.2.1.1    (DECEMBER 1979)                    PAGE 22
                                                                     ;
 
 
    "PROCEDURE" BACKWARD BABUSHKA;
    "BEGIN" PP:= YL; Y[N]:= G/CH;
      G:= PP; CH:= TL; L:= N;
      "FOR" L:= L - 1 "WHILE" L >= 0 "DO"
      "BEGIN" PP:= SUB[L]; PP:= PP/(CH - PP);
          TL:= T[L]; CH:= TL - CH*PP;
          YL:= Y[L]; G:= YL - G*PP;
          Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL)
      "END"
    "END" BACKWARD BABUSHKA;
 
    L:= 0; XL:= X[0];
    E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6];
    "FOR" L:= L + 1 "WHILE" L <= N "DO"
    "BEGIN" L1:= L - 1; XL1:= XL; XL:= X[L]; H:= XL - XL1;
      "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE"
                            ELEMENT MAT VEC EVALUATION 2;
      "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS;
      FORWARD BABUSHKA
    "END";
    BACKWARD BABUSHKA;
  "END" FEM LAG SPHER;
       "EOP"
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 1
 
 
 
 AUTHOR: M. BAKKER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 751231.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS A PROCEDURE FOR THE SOLUTION
     OF SECOND ORDER SKEW-ADJOINT LINEAR TWO POINT
     BOUNDARY VALUE PROBLEMS;
 
     FEM LAG SKEW;
 
     THIS PROCEDURE SOLVES THE DIFFERENTIAL EQUATION
 
        - Y'' + Q(X)*Y' + R(X)*Y = F(X), A < X < B,
 
      WITH BOUNDARY CONDITIONS
 
          E[1]*Y(A) + E[2]*Y'(A) = E[3],
 
          E[4]*Y(B) + E[5]*Y'(B) = E[6].
 
 
 KEY WORDS AND PHRASES:
 
     SECOND ORDER DIFFERENTIAL EQUATIONS,
     TWO POINT BOUNDARY VALUE PROBLEMS,
     SKEW-ADJOINT BOUNDARY VALUE PROBLEMS,
     GALERKIN'S METHOD,
     GLOBAL METHODS.
 
 
 LANGUAGE: ALGOL 60.
 
 
 REFERENCES:
 
     [1]  STRANG, G. AND G.J. FIX,
         AN ANALYSIS OF THE FINITE ELEMENT METHOD,
         PRENTICE-HALL, ENGLEWOOD CLIFFS, NEW JERSEY, 1973.
     [2]  BAKKER, M., EDITOR,
         COLLOQUIUM ON DISCRETIZATION METHODS, CHAPTER 3 (DUTCH),
         MATHEMATISCH CENTRUM, MC-SYLLABUS, 1976.
     [3]  HEMKER, P.W.,
         GALERKIN'S METHOD AND LOBATTO POINTS,
         MATHEMATISCH CENTRUM, REPORT 24/75 (1975).
     [4]  BABUSKA, I.,
         NUMERICAL STABILITY IN PROBLEMS OF LINEAR ALGEBRA,
         S.I.A.M.  J. NUM. ANAL., VOL.9, P. 53-77 (1972).
 
 
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 2
 
 
 
 SUBSECTION: FEM LAG SKEW.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" FEM LAG SKEW(X, Y, N, Q, R, F, ORDER, E);
     "VALUE" N, ORDER; "INTEGER" N, ORDER;
     "ARRAY" X, Y, E;
     "REAL" "PROCEDURE" Q, R, F;
     "CODE" 33302;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     N:  <ARITHMETIC EXPRESSION>;
        THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1;
 
     X:  <ARRAY IDENTIFIER>;
        "ARRAY" X[0:N];
        ENTRY: A = X[0] < X[1] < ... < X[N] = B IS  A
        PARTITION OF THE INTERVAL [A,B];
 
     Y:  <ARRAY IDENTIFIER>;
        "ARRAY" Y[0:N];
        EXIT: Y[I] (I = 0, 1, ... , N) IS THE APPROXIMATE
        SOLUTION AT X[I] TO THE DIFFERENTIAL EQUATION
 
        (1) - Y'' + Q(X)*Y' + R(X)*Y = F(X), A < X < B,
 
        WITH BOUNDARY CONDITIONS
 
               E[1]*Y(A) + E[2]*Y'(A) = E[3],
        (2)
               E[4]*Y(B) + E[5]*Y'(B) = E[6];
 
 
     Q:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF Q READS:
        "REAL" "PROCEDURE" Q(X); "VALUE" X; "REAL" X;
        Q(X) IS THE COEFFICIENT OF Y' IN (1);
 
     R:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF R READS:
        "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
        R(X) IS THE COEFFICIENT OF Y IN (1);
 
     F:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF F READS:
        "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
        F(X) IS THE RIGHT HAND SIDE OF (1);
 
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 3
 
 
 
     ORDER: <ARITHMETIC EXPRESSION>;
        ENTRY: ORDER DENOTES THE ORDER OF ACCURACY REQUIRED FOR THE
        APPROXIMATE SOLUTION OF (1)-(2); LET H = MAX(X[I] - X[I-1]);
        THEN  ABS(Y[I] - Y(X[I])) <= C*H**ORDER, I = 0, ... , N;
        ORDER CAN CAN BE CHOSEN EQUAL TO 2, 4 OR 6 ONLY;
 
     E:  <ARRAY IDENTIFIER>;
        "ARRAY" E[1:6];
        E[1], ... , E[6] DESCRIBE THE BOUNDARY CONDITIONS (2);
        E[1] AND E[4] ARE NOT ALLOWED TO VANISH BOTH.
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
 
     FOUR AUXILIARY ARRAYS OF N REALS ARE USED.
 
 
 RUNNING TIME:
 
     LET K = ORDER/2; THEN
 
     (A)   K*N + 1 EVALUATIONS OF Q(X), R(X) AND F(X) ARE NEEDED;
 
     (B)   ABOUT 17*2**(K-1)*N MULTIPLICATIONS/DIVISIONS ARE NEEDED.
 
 
 DATA AND RESULTS:
     THE PROCEDURE FEM LAG SKEW HAS SOME RESTRICTIONS IN ITS USE:
     (I)  Q(X) IS NOT ALLOWED TO HAVE VERY LARGE VALUES IN SOME SENSE:
      THE PRODUCT Q(X)*(X[J] - X[J-1]) SHOULD NOT BE TOO LARGE
      ON THE CLOSED INTERVAL <X[J-1],X[J]>, OTHERWISE
      THE BOUNDARY VALUE PROBLEM MAY DEGENERATE TO A SINGULAR
      PERTURBATION OR BOUNDARY LAYER PROBLEM, FOR WHICH EITHER
      SPECIAL METHODS OR A SUITABLY CHOSEN GRID ARE NEEDED;
     (II)  Q(X), R(X) AND F(X) ARE REQUIRED TO BE SUFFICIENTLY
      DIFFERENTIABLE ON THE DOMAIN OF THE BOUNDARY VALUE PROBLEM;
      THEY ARE, HOWEVER, THE DERIVATIVES ARE ALLOWED TO HAVE
      DISCONTINUITIES AT THE GRID POINTS, IN WHICH CASE THE ORDER OF
      ACCURACY (2, 4 OR 6) IS PRESERVED;
     (III)  IF Q(X) AND R(X) SATISFY THE INEQUALITY R(X) >= Q'(X)/2,
      THE EXISTENCE OF A UNIQUE SOLUTION IS GUARANTEED, OTHERWISE
      THIS REMAINS AN OPEN QUESTION;
     (IV) THE USER SHOULD NOT EXPECT GREATER ACCURACY THAN 12 DECIMALS
      DUE TO THE LOSS OF DIGITS DURING THE EVALUATION OF THE MATRIX
      AND THE VECTOR OF THE LINEAR SYSTEM TO BE SOLVED AND DURING ITS
      REDUCTION TO A TRIDIAGONAL SYSTEM; WHEN THE SOLUTION OF THE
      PROBLEM IS NOT TOO WILD, THIS 12-DIGITS ACCURACY CAN BE OBTAINED
      WITH A MODERATE MESH SIZE (E.G. < 0.1) ALREADY, PROVIDED
      A SIXTH ORDER METHOD IS USED.
 
 
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 4
 
 
 
 METHOD AND PERFORMANCE:
 
     PROBLEM (1)-(2) IS SOLVED BY MEANS OF GALERKIN'S METHOD WITH
     CONTINUOUS PIECEWISE POLYNOMIAL FUNCTIONS (SEE [1], [2]);
     THE SOLUTION IS APPROXIMATED BY A FUNCTION WHICH IS CONTINUOUS
     ON THE INTERVAL <X[0],X[N]> AND A POLYNOMIAL OF DEGREE LESS THAN
     OR EQUAL TO K (K = ORDER//2) ON EACH SEGMENT <X[J-1],X[J]>
     (J = 1, ..., N); THIS
     PIECEWISE POLYNOMIAL IS ENTIRELY DETERMINED BY THE VALUES IT HAS
     AT THE KNOTS X[J] AND ON (K-1) INTERIOR KNOTS ON EACH SEGMENT
     <X[J-1],X[J]>; THESE VALUES ARE OBTAINED BY THE SOLUTION OF AN
     (ORDER + 1)-DIAGONAL LINEAR SYSTEM WITH A SPECIALLY STRUCTURED
     MATRIX (SEE [2]); THE ENTRIES OF THE MATRIX AND THE VECTOR ARE
     INNER PRODUCTS WHICH ARE APPROXIMATED BY PIECEWISE (K+1)-POINT
     LOBATTO QUADRATURE (SEE [3]); THE EVALUATION OF THE MATRIX AND
     THE VECTOR IS DONE SEGMENT BY SEGMENT: ON EACH SEGMENT
     THE CONTRIBUTIONS TO THE ENTRIES OF THE MATRIX AND THE
     VECTOR ARE COMPUTED AND EMBEDDED IN THE GLOBAL MATRIX AND
     VECTOR; SINCE THE FUNCTION VALUES ON THE INTERIOR
     POINTS OF EACH SEGMENT ARE NOT COUPLED WITH THE FUNCTION
     VALUES OUTSIDE THAT SEGMENT, THE RESULTING LINEAR SYSTEM
     CAN BE REDUCED TO A TRIDIAGONAL SYSTEM BY MEANS OF STATIC
     CONDENSATION (SEE [2]); SINCE THE FINAL TRIDIAGONAL SYSTEM
     IS OF FINITE DIFFERENCE TYPE, IT IS SOLVED BY MEANS
     OF BABUSKA'S METHOD (SEE [4]).
 
 
 EXAMPLE OF USE:
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
 
     - Y'' + Y'*COS(X) + Y*EXP(X) = SIN(X)*(1 + EXP(X)) + COS(X)**2,
        0 < X < PI = 3.14159265358979, Y(0) = Y(PI) = 0;
 
     FOR THE BOUNDARY CONDITIONS THIS MEANS THAT
 
        E[1] = E[4] = 1; E[2] = E[3] = E[5] = E[6] = 0;
 
     THE ANALYTIC SOLUTION IS Y(X) = SIN(X); WE APPROXIMATE
     THE SOLUTION ON A UNIFORM GRID, I.E. X[I] = I*PI/N,
     I = 0, ..., N; WE CHOOSE N=10,20 AND COMPUTE FOR ORDER = 2,4,6
     THE MAXIMUM ERROR; THE PROGRAM READS AS FOLLOWS:
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 5
 
 
 
     "BEGIN" "INTEGER" N; "FOR" N:= 10, 20 "DO"
     "BEGIN" "INTEGER" I, ORDER; "REAL" PI; "ARRAY" X, Y[0:N], E[1:6];
 
        "REAL" "PROCEDURE" Q(X); "VALUE" X; "REAL" X;
        Q:= COS(X);
 
        "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
        R:= EXP(X);
 
        "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
        F:= SIN(X)*(1 + EXP(X)) + COS(X)**2;
 
        E[1]:= E[4]:= 1; E[2]:= E[3]:= E[5]:= E[6]:= 0;
        PI:= 3.14159265358979;
        "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= PI*I/N;
        OUTPUT(61,"("//,6B"("N=")"ZD")",N);
        "FOR" ORDER:= 2, 4, 6 "DO"
        "BEGIN" "REAL" RHO, D;
            FEM LAG SKEW(X, Y, N, Q, R, F, ORDER, E);
            RHO:= 0;
            "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO"
            "BEGIN" D:= ABS(Y[I] - SIN(X[I]));
                "IF" RHO < D "THEN" RHO:= D
            "END";
            OUTPUT(61,"("/,16B"("ORDER=")"D,4B"("MAX.ERROR= ")",
            D.DD"+ZD")",ORDER,RHO)
        "END"
     "END"
     "END"
 
     RESULTS:
 
     N=10
              ORDER=2  MAX. ERROR= 2.95" -3
              ORDER=4  MAX. ERROR= 2.56" -5
              ORDER=6  MAX. ERROR= 4.26" -8
 
     N=20
              ORDER=2  MAX. ERROR= 7.55" -4
              ORDER=4  MAX. ERROR= 1.68" -6
              ORDER=6  MAX. ERROR= 6.76"-10
 
     NOTICE THAT THE MAXIMUM ERROR DECREASES BY ABOUT
     2**(-ORDER)  WHEN THE MESH SIZE IS HALVED.
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 6
 
 
 
 SOURCE TEXT(S):
0"CODE" 33302;
  "PROCEDURE" FEM LAG SKEW(X, Y, N, Q, R, F, ORDER, E);
  "VALUE" N, ORDER; "INTEGER" N, ORDER;
  "REAL" "PROCEDURE" Q, R, F;
  "ARRAY" X, Y, E;
  "BEGIN" "INTEGER" L, L1;
    "REAL" XL1, XL, H, A12, A21, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP,
     E1, E2, E3, E4, E5, E6;
    "ARRAY" T, SUPER, SUB, CHI, GI[0:N-1];
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 1;
    "BEGIN" "OWN" "REAL" Q2, R2, F2;
     "REAL" Q1, R1, F1, H2, S12;
     "IF" L=1 "THEN"
     "BEGIN" Q2:= Q(XL1); R2:= R(XL1); F2:= F(XL1) "END";
     H2:= H/2; S12:= - 1/H;
     Q1:= Q2; Q2:= Q(XL);
     R1:= R2; R2:= R(XL);
     F1:= F2; F2:= F(XL);
     B1:= H2*F1; B2:= H2*F2;
     TAU1:= H2*R1; TAU2:= H2*R2;
     A12:= S12 + Q1/2; A21:= S12 - Q2/2
    "END" ELEMENT MAT VEC EV.;
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 2;
    "BEGIN" "OWN" "REAL" Q3, R3, F3;
     "REAL" Q1, Q2, R1, R2, F1, F2, S12, S13, S22, X2, H6, H15,
       C12, C32, A13, A31, A22, A23, A32, B3, TAU3;
     "IF" L=1 "THEN"
     "BEGIN" Q3:= Q(XL1); R3:= R(XL1); F3:= F(XL1) "END";
 
     X2:= (XL1 + XL)/2; H6:= H/6; H15:= H/1.5;
     Q1:= Q3; Q2:= Q(X2); Q3:= Q(XL);
     R1:= R3; R2:= R(X2); R3:= R(XL);
     F1:= F3; F2:= F(X2); F3:= F(XL);
     B1:= H6*F1; B2:= H15*F2; B3:= H6*F3;
     TAU1:= H6*R1; TAU2:= H15*R2; TAU3:= H6*R3;
     S12:= - 1/H/0.375; S13:= - S12/8; S22:= - 2*S12;
     A12:= S12 + Q1/1.5; A13:= S13 - Q1/6;
     A21:= S12 - Q2/1.5; A23:= S12 + Q2/1.5; A22:= S22 + TAU2;
     A31:= S13 + Q3/6; A32:= S12 - Q3/1.5;
     "COMMENT" STATIC CONDENSATION;
     C12:= - A12/A22; C32:= - A32/A22;
     A12:= A13 + C12*A23; A21:= A31 + C32*A21;
     B1:= B1 + C12*B2; B2:= B3 + C32*B2;
     TAU1:= TAU1 + C12*TAU2; TAU2:= TAU3 + C32*TAU2
    "END" ELEMENT MAT VEC EVALUATION 2
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 7
                                                                ;
 
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 3;
    "BEGIN" "OWN" "REAL" Q4, R4, F4;
     "REAL" Q1, Q2, Q3, R1, R2, R3, F1, F2, F3,
      S12, S13, S14, S22, S23, X2, X3, H12, H24,
      DET, C12, C13, C42, C43, A13, A14, A22, A23,
      A24, A31, A32, A33, A34, A41, A42, A43,
      B3, B4, TAU3, TAU4;
 
     "IF" L=1 "THEN"
     "BEGIN" Q4:= Q(XL1); R4:= R(XL1); F4:= F(XL1) "END";
     X2:= XL1 + 0.27639320225*H; X3:= XL - X2 + XL1;
     H12:= H/12; H24:= H/2.4;
     Q1:= Q4; Q2:= Q(X2); Q3:= Q(X3); Q4:= Q(XL);
     R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL);
     F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL);
     S12:= -4.8784183052080/H; S13:= 0.7117516385414/H;
     S14:= -.16666666666667/H; S23:= 25*S14; S22:= -2*S23;
     B1:= H12*F1; B2:= H24*F2; B3:= H24*F3; B4:= H12*F4;
     TAU1:= H12*R1; TAU2:= H24*R2; TAU3:= H24*R3; TAU4:= H12*R4;
     A12:= S12 + 0.67418082864578*Q1;
     A13:= S13 - 0.25751416197912*Q1;
     A14:= S14 + Q1/12;
     A21:= S12 - 0.67418082864578*Q2;
     A22:= S22 + TAU2;
     A23:= S23 + 0.93169499062490*Q2;
     A24:= S13 - 0.25751416197912*Q2;
     A31:= S13 + 0.25751416197912*Q3;
     A32:= S23 - 0.93169499062490*Q3;
     A33:= S22 + TAU3;
     A34:= S12 + 0.67418082864578*Q3;
     A41:= S14 - Q4/12;
     A42:= S13 + 0.25751416197912*Q4;
     A43:= S12 - 0.67418082864578*Q4;
     "COMMENT" STATIC CONDENSATION;
     DET:= A22*A33 - A23*A32;
     C12:= (A13*A32 - A12*A33)/DET;
     C13:= (A12*A23 - A13*A22)/DET;
     C42:= (A32*A43 - A42*A33)/DET;
     C43:= (A42*A23 - A43*A22)/DET;
     TAU1:= TAU1 + C12*TAU2 + C13*TAU3 ;
     TAU2:= TAU4 + C42*TAU2 + C43*TAU3;
     A12:= A14 + C12*A24 + C13*A34;
     A21:= A41 + C42*A21 + C43*A31;
     B1:= B1 + C12*B2 + C13*B3;
     B2:= B4 + C42*B2 + C43*B3
    "END" ELEMENT MAT VEC EVALUATION 3
1SECTION : 5.2.1.2.1.2.1.2    (JANUARY 1976)                      PAGE 8
                                                                ;
 
 
    "PROCEDURE" BOUNDARY CONDITIONS;
    "IF" L=1 "AND" E2 = 0 "THEN"
    "BEGIN" TAU1:= 1; B1:= E3/E1; A12:= 0 "END"
    "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN"
    "BEGIN" TAU1:= TAU1 - E1/E2; B1:= B1 - E3/E2
    "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN"
    "BEGIN" TAU2:= 1; A21:= 0; B2:= E6/E4;
    "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN"
    "BEGIN" TAU2:= TAU2 + E4/E5; B2:= B2 + E6/E5
    "END" B.C.1;
 
    "PROCEDURE" FORWARD BABUSKA;
    "IF" L=1 "THEN"
    "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL;
       GI[0]:= G:= YL:= B1; Y[0]:= YL;
       SUB[0]:= A21; SUPER[0]:= A12;
       PP:= A21/(CH - A12); CH:= TAU2 - CH*PP;
       G:= B2 - G*PP; TL:= TAU2; YL:= B2
    "END" "ELSE"
    "BEGIN" CHI[L1]:= CH:= CH + TAU1;
       GI[L1]:= G:= G + B1;
       SUB[L1]:= A21; SUPER[L1]:= A12;
       PP:= A21/(CH - A12); CH:= TAU2 - CH*PP;
       G:= B2 - G*PP; T[L1]:= TL + TAU1; TL:= TAU2;
       Y[L1]:= YL +  B1; YL:= B2
    "END" FORWARD BABUSKA;
 
    "PROCEDURE" BACKWARD BABUSKA;
    "BEGIN"PP:= YL; Y[N]:= G/CH;
       G:= PP; CH:= TL; L:= N;
       "FOR" L:= L - 1 "WHILE" L >= 0 "DO"
       "BEGIN" PP:= SUPER[L]/(CH - SUB[L]);
         TL:= T[L]; CH:= TL - CH*PP;
         YL:= Y[L]; G:= YL - G*PP;
         Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL)  ;
       "END"
    "END" BACKWARD BABUSKA;
 
    L:= 0; XL:= X[0];
    E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6];
    "COMMENT" ELEMENTWISE ASSEMBLAGE OF MATRIX AND VECTOR
     COMBINED WITH FORWARD BABUSKA SUBSTITUTION;
    "FOR" L:= L + 1 "WHILE" L <= N "DO"
    "BEGIN" XL1:= XL; L1:= L - 1; XL:= X[L]; H:= XL - XL1;
     "IF" ORDER = 2 "THEN" ELEMENT MAT VEC EVALUATION 1 "ELSE"
     "IF" ORDER = 4 "THEN" ELEMENT MAT VEC EVALUATION 2 "ELSE"
     ELEMENT MAT VEC EVALUATION 3;
     "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS;
     FORWARD BABUSKA
    "END";
    BACKWARD BABUSKA;
  "END" FEM LAGR;
      "EOP"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 1
 
 
 
 AUTHOR: M. BAKKER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 751231.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS A PROCEDURE FOR THE SOLUTION
     OF FOURTH ORDER SELF-ADJOINT LINEAR TWO POINT
     BOUNDARY VALUE PROBLEMS;
 
     FEM HERM SYM;
 
     THIS PROCEDURE SOLVES THE DIFFERENTIAL EQUATION
 
       (P(X)*Y'')'' - (Q(X)*Y')' + R(X)*Y = F(X),  A < X < B,
 
      WITH BOUNDARY CONDITIONS
 
          Y(A) = E[1], Y'(A) = E[2],
 
          Y(B) = E[3], Y'(B) = E[4].
 
 
 KEY WORDS AND PHRASES:
 
     FOURTH ORDER DIFFERENTIAL EQUATIONS,
     TWO POINT BOUNDARY VALUE PROBLEMS,
     SELF-ADJOINT BOUNDARY VALUE PROBLEMS,
     GALERKIN'S METHOD,
     DIRICHLET BOUNDARY CONDITIONS,
     GLOBAL METHODS.
 
 
 LANGUAGE: ALGOL 60.
 
 
 REFERENCES:
 
     [1]  STRANG, G. AND G.J. FIX,
         AN ANALYSIS OF THE FINITE ELEMENT METHOD,
         PRENTICE-HALL, ENGLE WOOD CLIFFS, NEW JERSEY, 1973.
 
     [2]  BAKKER, M., EDITOR,
         COLLOQUIUM ON DISCRETIZATION METHODS, CHAPTER 3 (DUTCH),
         MATHEMATISCH CENTRUM, MC-SYLLABUS, 1976.
 
     [3]  HEMKER, P.W.,
         GALERKIN'S METHOD AND LOBATTO POINTS,
         MATHEMATISCH CENTRUM, REPORT 24/75 (1975).
 
 
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 2
 
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" FEM HERM SYM(X, Y, N, P, Q, R, F, ORDER, E);
     "VALUE" N, ORDER; "INTEGER" N, ORDER;
     "ARRAY" X, Y, E;
     "REAL" "PROCEDURE" P, Q, R, F;
     "CODE" 33303;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     N:  <ARITHMETIC EXPRESSION>;
        THE UPPER BOUND OF THE ARRAY X; N > 1;
 
     X:  <ARRAY IDENTIFIER>;
        "ARRAY" X[0:N];
        ENTRY: A = X[0] < X[1] < ... < X[N] = B IS  A
        PARTITION OF THE INTERVAL [A,B];
 
     Y:  <ARRAY IDENTIFIER>;
        "ARRAY" Y[1:2*N-2];
        EXIT: Y[2*I-1] IS AN APPROXIMATION TO Y(X[I]),
        Y[2*I] IS AN APPROXIMATION TO Y'(X[I]),
        WHERE Y(X) IS THE SOLUTION OF THE DIFFERENTIAL EQUATION
 
        (1) (P(X)*Y'')'' - (Q(X)*Y')' + R(X)*Y = F(X)  , A< X < B,
 
        WITH BOUNDARY CONDITIONS
 
               Y(A) = E[1], Y'(A) = E[2],
        (2)
               Y(B) = E[3], Y'(B) = E[4];
 
 
     P:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF P READS:
        "REAL" "PROCEDURE" P(X); "VALUE" X; "REAL" X;
        P(X) IS THE COEFFICIENT OF Y'' IN (1);
        P(X) SHOULD BE STRICTLY POSITIVE;
 
     Q:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF Q READS:
        "REAL" "PROCEDURE" Q(X); "VALUE" X; "REAL" X;
        Q(X) IS THE COEFFICIENT OF Y' IN (1);
        Q(X) SHOULD BE NONNEGATIVE;
 
     R:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF R READS:
        "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
        R(X) IS THE COEFFICIENT OF Y IN (1);
        R(X) SHOULD BE NONNEGATIVE;
 
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 3
 
 
 
     F:  <PROCEDURE IDENTIFIER>;
        THE HEADING OF F READS:
        "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
        F(X) IS THE RIGHT HAND SIDE OF (1);
 
     ORDER: <ARITHMETIC EXPRESSION>;
        ENTRY: ORDER DENOTES THE ORDER OF ACCURACY REQUIRED FOR THE
        APPROXIMATE SOLUTION OF (1)-(2); LET H = MAX(X[I] - X[I-1]);
        THEN
            ABS(Y[2*I-1]-Y(X[I])) <= C1 * H**ORDER,
            ABS(Y[2*I]-Y'(X[I])   <= C2 * H**ORDER, I = 1,...,N-1;
        ORDER CAN ONLY BE CHOSEN EQUAL TO 4, 6, 8;
 
     E:  <ARRAY IDENTIFIER>;
        "ARRAY" E[1:4];
        E[1], ... , E[4] DESCRIBE THE BOUNDARY CONDITIONS (2).
 
 
 PROCEDURES USED: CHLDECSOLBND = CP 34333
 
 
 REQUIRED CENTRAL MEMORY:
 
     ONE AUXILIARY ARRAY OF 8*(N-1) REALS IS USED.
 
 
 RUNNING TIME:
 
     LET K = ORDER/2; THEN
 
     (A)   K*N + 1 EVALUATIONS OF P(X), Q(X), R(X) AND F(X) ARE NEEDED;
 
     (B)   ABOUT (ORDER-3)*50*N MULTIPLICATIONS/DIVISIONS ARE NEEDED;
 
     (C)   ONE CALL OF CHLDECSOLBND IS DONE.
 
 
 DATA AND RESULTS:
 
     THE PROCEDURE FEM HERM SYM HAS SOME RESTRICTIONS:
     (I)  P(X) SHOULD BE POSITIVE ON THE CLOSED
      INTERVAL <X[0],X[N]> AND Q(X) AND R(X) SHOULD BE
      NONNEGATIVE THERE;
     (II)  P(X), Q(X), R(X) AND F(X) ARE REQUIRED TO BE SUFFICIENTLY
      SMOOTH ON THE  INTERVAL <X[0],X[N]> EXCEPT AT THE KNOTS,
      WHERE DISCONTINUITIES OF THE DERIVATIVES ARE ALLOWED;
      IN THAT CASE THE ORDER OF ACCURACY IS PRESERVED;
     (III)  THE USER SHOULD NOT EXPECT HIGHER ACCURACY THAN 12
      DECIMALS DUE TO THE LOSS OF DIGITS DURING THE EVALUATION OF THE
      MATRIX AND VECTOR AND DURING THE REDUCTION TO A PENTADIAGONAL
      SYSTEM; THIS ACCURACY CAN BE REACHED VERY EASILY WHEN AN EIGTH
      ORDER METHOD IS USED
 
 
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 4
 
 
 
 METHOD AND PERFORMANCE:
 
     PROBLEM (1)-(2) IS SOLVED BY MEANS OF GALERKIN'S METHOD WITH
     CONTINUOUSLY DIFFERENTIABLE PIECEWISE POLYNOMIAL FUNCTIONS
     (SEE [1], [2]) : THE SOLUTION IS APPROXIMATED BY A FUNCTION
     WHICH IS CONTINUOUSLY DIFFERENTIABLE ON THE CLOSED INTERVAL
     <X[0],X[N]> AND A POLYNOMIAL OF DEGREE LESS THAN OR EQUAL TO
     K (K = 1 + ORDER//2) ON EACH CLOSED SEGMENT <X[J-1],X[J]>
     (J = 1, ..., N);
     THIS FUNCTION IS ENTIRELY DETERMINED BY THE VALUES OF
     THE ZEROETH AND FIRST DERIVATIVE AT THE KNOTS X[J] AND BY
     THE VALUES IT HAS AT (K-3) INTERIOR KNOTS ON EACH CLOSED
     SEGMENT <X[J-1],X[J]>; THE VALUES OF THE FUNCTION AND ITS
     DERIVATIVE AT THE KNOTS ARE OBTAINED BY THE SOLUTION OF AN
     (ORDER + 1)-DIAGONAL LINEAR SYSTEM OF (K-1)*N - 2 UNKNOWNS;
     THE ENTRIES OF THE MATRIX AND THE VECTOR ARE INNER PRODUCTS
     WHICH ARE APPROXIMATED BY PIECEWISE K-POINT LOBATTO
     QUADRATURE (SEE [3]); THE EVALUATION OF THE MATRIX AND
     VECTOR IS PERFORMED SEGMENT BY SEGMENT;
     IF K > 3 THE RESULTING LINEAR SYSTEM CAN BE REDUCED
     TO A PENTADIAGONAL SYSTEM BY MEANS OF STATIC
     CONDENSATION; THIS IS POSSIBLE BECAUSE THE FUNCTION
     VALUES AT THE INTERIOR KNOTS ON EACH SEGMENT <X[J-1],X[J]>
     DO NOT DEPEND ON FUNCTION VALUES OUTSIDE THAT SEGMENT;
     THE FINAL PENTADIAGONAL SYSTEM, SINCE THE MATRIX IS POSITIVE
     DEFINITE AND SYMMETRIC, IS SOLVED BY MEANS OF CHOLESKY'S
     DECOMPOSITION METHOD (SEE SECTION  3.1.2.1.1.2.1.3).
 
 
 EXAMPLE OF USE:
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
     Y'''' - (Y'*COS(X))' + Y*EXP(X) = SIN(X)*(1 + EXP(X) + COS(X)*2),
        0 < X < PI;
        Y(0) = Y(PI) = 0; Y'(0) = 1; Y'(PI) = -1;
                          PI = 3.14159265358979;
 
     THE ANALYTIC SOLUTION IS Y(X) = SIN(X); WE APPROXIMATE
     THE SOLUTION ON A UNIFORM GRID, I.E. X[I] = I*PI/N,
     I = 0, ..., N; WE CHOOSE N = 5, 10 AND WE COMPUTE
     THE MAXIMUM DEVIATIONS FROM Y(X[I]) AND Y'(X[I])
     FOR ORDER = 4, 6, 8;
     THE PROGRAM READS AS FOLLOWS:
1SECTION : 5.2.1.2.1.2.2.1    (JANUARY 1976)                      PAGE 5
 
 
 
 
     "BEGIN" "INTEGER" N; "FOR" N:= 5, 10 "DO"
     "BEGIN" "INTEGER" I, ORDER; "REAL" PI; "ARRAY" X[0:N],
                                         Y[1:2*N-2], E[1:4];
 
        "REAL" "PROCEDURE" P(X); "VALUE" X; "REAL" X; P:= 1;
 
        "REAL" "PROCEDURE" Q(X); "VALUE" X; "REAL" X;
        Q:= COS(X);
 
        "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X;
        R:= EXP(X);
 
        "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X;
        F:= SIN(X)*(1 + EXP(X)+ 2*COS(X));
 
        E[1]:= E[3]:= 0; E[2]:= 1; E[4]:= - 1;
        PI:= 3.14159265358979;
        "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO" X[I]:= PI*I/N;
        OUTPUT(61,"("//,6B"("N=")"ZD")",N);
        "FOR" ORDER:= 4, 6, 8 "DO"
        "BEGIN" "REAL" RHO1, RHO2, D1, D2;
            FEM HERM SYM(X, Y, N, P, Q, R, F, ORDER, E);
            RHO1:= RHO2:= 0;
            "FOR" I:= 1 "STEP" 1 "UNTIL" N - 1 "DO"
            "BEGIN" D1:= ABS(Y[2*I-1] - SIN(X[I]));
                "IF" RHO1 < D1 "THEN" RHO1:= D1;
                D2:= ABS(Y[2*I] - COS(X[I]));
                "IF" RHO2 < D2 "THEN" RHO2:= D2
            "END";
            OUTPUT(61,"("/,16B"("ORDER=")"D,/,
            24B"("MAX ABS(Y[2*I-1]-Y(X[I])) = ")",D.3D"+ZD,
            /,24B"("MAX ABS(Y[2*I]-Y'(X[I]))  = ")",D.3D"+ZD")",
                 ORDER,RHO1,RHO2)
        "END"
     "END"
     "END"
1SECTION : 5.2.1.2.1.2.2.1    (JANUARY 1976)                      PAGE 6
 
 
 
 
     RESULTS:
 
     N= 5
         ORDER=4
              MAX ABS(Y[2*I-1]-Y(X[I])) = 4.822" -4
              MAX ABS(Y[2*I]-Y'(X[I]))  = 4.548" -4
         ORDER=6
              MAX ABS(Y[2*I-1]-Y(X[I])) = 5.651" -6
              MAX ABS(Y[2*I]-Y'(X[I]))  = 2.035" -6
         ORDER=8
              MAX ABS(Y[2*I-1]-Y(X[I])) = 2.264" -8
              MAX ABS(Y[2*I]-Y'(X[I]))  = 1.600" -8
 
     N=10
         ORDER=4
              MAX ABS(Y[2*I-1]-Y(X[I])) = 2.657" -5
              MAX ABS(Y[2*I]-Y'(X[I]))  = 2.870" -5
         ORDER=6
              MAX ABS(Y[2*I-1]-Y(X[I])) = 8.398" -8
              MAX ABS(Y[2*I]-Y'(X[I]))  = 3.572" -8
         ORDER=8
              MAX ABS(Y[2*I-1]-Y(X[I])) = 7.981"-11
              MAX ABS(Y[2*I]-Y'(X[I]))  = 6.796"-11
 
     NOTICE THAT THE MAXIMUM ERROR IS DIVIDED BY
     2**ORDER, WHEN THE MESH SIZE IS HALVED.
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 7
 
 
 
 SOURCE TEXT(S):
0"CODE" 33303;
  "PROCEDURE"  FEM HERM SYM(X, Y, N, P, Q, R, F, ORDER, E);
  "VALUE" N, ORDER; "INTEGER" N, ORDER;
  "ARRAY" X, Y, E;
  "REAL" "PROCEDURE"  P, Q, R, F;
  "BEGIN" "INTEGER" L, N2, V, W;
    "ARRAY" A[1:8*(N - 1)], EM[2:3];
    "REAL" A11, A12, A13, A14, A22, A23, A24, A33, A34, A44,
     YA, YB, ZA, ZB,
     B1, B2, B3, B4, D1, D2, E1, R1, R2, XL1, XL;
 
    "PROCEDURE" ELEMENTMATVECEVALUATION;
    "IF"ORDER=4"THEN"
    "BEGIN" "REAL" X2, H, H2, H3, P1, P2,
      Q1, Q2, R1, R2, F1, F2,
      B11, B12, B13, B14, B22, B23, B24, B33, B34, B44,
      S11, S12, S13, S14, S22, S23, S24, S33, S34, S44,
      M11, M12, M13, M14, M22, M23, M24, M33, M34, M44;
      "OWN" "REAL"P3, Q3, R3, F3;
 
      H:= XL - XL1; H2:= H*H; H3:= H*H2;
      X2:= (XL1 + XL)/2;
      "IF"L=1"THEN"
      "BEGIN"P3:= P(XL1); Q3:= Q(XL1); R3:= R(XL1); F3:= F(XL1)
      "END";
 
      "COMMENT" ELEMENT BENDING MATRIX;
      P1:= P3; P2:= P(X2); P3:= P(XL);
      B11:= 6*(P1 + P3); B12:= 4*P1 + 2*P3;
      B13:= - B11; B14:= B11 - B12;
      B22:= (4*P1 + P2 + P3)/1.5; B23:= - B12; B24:= B12 - B22;
      B33:= B11; B34:= - B14; B44:= B14 - B24;
 
      "COMMENT" ELEMENT STIFFNESS MATRIX;
      Q1:= Q3; Q2:= Q(X2); Q3:= Q(XL);
      S11:= 1.5*Q2; S12:= Q2/4; S13:= - S11; S14:= S12;
      S24:= Q2/24; S22:= Q1/6 + S24; S23:= - S12;
      S33:= S11; S34:= - S12; S44:= S24 + Q3/6;
 
      "COMMENT" ELEMENT MASS MATRIX;
      R1:= R3; R2:= R(X2); R3:= R(XL);
      M11:= (R1 + R2)/6; M12:= R2/24; M13:= R2/6; M14:= - M12;
      M22:= R2/96; M23:= - M14; M24:= - M22;
      M33:= (R2 + R3)/6; M34:= M14; M44:= M22;
 
      "COMMENT" ELEMENT LOAD VECTOR;
      F1:= F3; F2:= F(X2); F3:= F(XL);
      B1:= H*(F1 + 2*F2)/6; B3:= H*(F3 + 2*F2)/6;
      B2:= H2*F2/12; B4:= - B2;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 8
                                                                ;
 
 
      A11:= B11/H3 + S11/H + M11*H; A12:= B12/H2 + S12 + M12*H2;
      A13:= B13/H3 + S13/H + M13*H; A14:= B14/H2 + S14 + M14*H2;
      A22:= B22/H + S22*H + M22*H3; A23:= B23/H2 + S23 + M23*H2;
      A24:= B24/H + S24*H + M24*H3; A34:= B34/H2 + S34 + M34*H2;
      A33:= B33/H3 + S33/H + M33*H; A44:= B44/H + S44*H + M44*H3
    "END" "ELSE" "IF"ORDER=6"THEN"
    "BEGIN" "OWN" "REAL"P4, Q4, R4, F4;
      "REAL"H, H2, H3, X2, X3,
      P1, P2, P3, Q1, Q2, Q3,
      R1, R2, R3, F1, F2, F3,
      B11, B12, B13, B14, B15, B22, B23, B24, B25,
      B33, B34, B35, B44, B45, B55,
      S11, S12, S13, S14, S15, S22, S23, S24, S25,
      S33, S34, S35, S44, S45, S55,
      M11, M12, M13, M14, M15, M22, M23, M24, M25,
      M33, M34, M35, M44, M45, M55,
      A15, A25, A35, A45, A55, C1, C2, C3, C4, B5;
      "IF"L=1"THEN"
      "BEGIN"P4:= P(XL1); Q4:= Q(XL1); R4:= R(XL1); F4:= F(XL1)
      "END";
 
      H:= XL - XL1; H2:= H*H; H3:= H*H2;
      X2:= 0.27639320225*H + XL1; X3:= XL1 + XL - X2;
 
      "COMMENT" ELEMENT BENDING MATRIX;
      P1:= P4; P2:= P(X2); P3:= P(X3); P4:= P(XL);
      B11:= + 4.0333333333333"+1*P1 + 1.1124913866738"-1*P2
            + 1.4422084194664"+1*P3 + 8.3333333333333"+0*P4;
      B12:= + 1.4666666666667"+1*P1 - 3.3191425091659"-1*P2
            + 2.7985809175818"+0*P3 + 1.6666666666667"+0*P4;
      B13:= + 1.8333333333333"+1*(P1+P4)
            + 1.2666666666667"+0*(P2+P3);
      B15:= - (B11 + B13); B14:= - (B12 + B13 + B15/2);
      B22:= + 5.3333333333333"+0*P1 + 9.9027346441674"-1*P2
            + 5.4305986891624"-1*P3 + 3.3333333333333"-1*P4;
      B23:= + 6.6666666666667"+0*P1 - 3.7791278464167"+0*P2
            + 2.4579451308295"-1*P3 + 3.6666666666667"+0*P4;
      B25:= - (B12 + B23); B24:= - (B22 + B23 + B25/2);
      B33:= + 8.3333333333333"+0*P1 + 1.4422084194666"+1*P2
            + 1.1124913866726"-1*P3 + 4.0333333333333"+1*P4;
      B35:= - (B13 + B33); B34:= - (B23 + B33 + B35/2);
      B45:= - (B14 + B34); B44:= - (B24 + B34 + B45/2);
      B55:= - (B15 + B35);
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                      PAGE 9
                                                                ;
 
 
      "COMMENT" ELEMENT STIFFNESS MATRIX;
      Q1:= Q4; Q2:= Q(X2); Q3:= Q(X3); Q4:= Q(XL);
      S11:= + 2.8844168389330"+0*Q2 + 2.2249827733448"-2*Q3;
      S12:= + 2.5671051872498"-1*Q2 + 3.2894812749994"-3*Q3;
      S13:= + 2.5333333333333"-1*(Q2+Q3);
      S14:= - 3.7453559925005"-2*Q2 - 2.2546440074988"-2*Q3;
      S15:= - (S13 + S11);
      S22:= + 8.3333333333333"-2*Q1 + 2.2847006554164"-2*Q2
            + 4.8632677916445"-4*Q3;
      S23:= + 2.2546440075002"-2*Q2 + 3.7453559924873"-2*Q3;
      S24:= - 3.3333333333333"-3*(Q2+Q3);
      S25:= - (S12 + S23);
      S33:= + 2.2249827733471"-2*Q2 + 2.8844168389330"+0*Q3;
      S34:= - 3.2894812750127"-3*Q2 - 2.5671051872496"-1*Q3;
      S35:= - (S13 + S33);
      S44:= + 4.8632677916788"-4*Q2
            + 2.2847006554161"-2*Q3 + 8.3333333333338"-2*Q4;
      S45:= - (S14 + S34);
      S55:= - (S15 + S35);
 
      "COMMENT" ELEMENT MASS MATRIX;
      R1:= R4; R2:= R(X2); R3:= R(X3); R4:= R(XL);
      M11:= + 8.3333333333333"-2*R1 + 1.0129076086083"-1*R2
            + 7.3759058058380"-3*R3;
      M12:= + 1.3296181273333"-2*R2 + 1.3704853933353"-3*R3;
      M13:= - 2.7333333333333"-2*(R2+R3);
      M14:= + 5.0786893258335"-3*R2 + 3.5879773408333"-3*R3;
      M15:= + 1.3147987115999"-1*R2 - 3.5479871159991"-2*R3;
      M22:= + 1.7453559925000"-3*R2 + 2.5464400750059"-4*R3;
      M23:= - 3.5879773408336"-3*R2 - 5.0786893258385"-3*R3;
      M24:= + 6.6666666666667"-4*(R2+R3);
      M25:= + 1.7259029213333"-2*R2 - 6.5923625466719"-3*R3;
      M33:= + 7.3759058058380"-3*R2
            + 1.0129076086083"-1*R3 + 8.3333333333333"-2*R4;
      M34:= - 1.3704853933333"-3*R2 - 1.3296181273333"-2*R3;
      M35:= - 3.5479871159992"-2*R2 + 1.3147987115999"-1*R3;
      M44:= + 2.5464400750008"-4*R2 + 1.7453559924997"-3*R3;
      M45:= + 6.5923625466656"-3*R2 - 1.7259029213330"-2*R3;
      M55:= + .17066666666667"+0*(R2+R3);
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                     PAGE 10
                                                               ;
 
 
      "COMMENT" ELEMENT LOAD VECTOR;
      F1:= F4; F2:= F(X2); F3:= F(X3); F4:= F(XL);
      B1:= + 8.3333333333333"-2*F1 + 2.0543729868749"-1*F2
           - 5.5437298687489"-2*F3;
      B2:= + 2.6967233145832"-2*F2 - 1.0300566479175"-2*F3;
      B3:= - 5.5437298687489"-2*F2
           + 2.0543729868749"-1*F3 + 8.3333333333333"-2*F4;
      B4:= + 1.0300566479165"-2*F2 - 2.6967233145830"-2*F3;
      B5:= + 2.6666666666667"-1*(F2+F3);
 
      A11:= H2*(H2*M11 + S11) + B11; A12:= H2*(H2*M12 + S12) + B12;
      A13:= H2*(H2*M13 + S13) + B13; A14:= H2*(H2*M14 + S14) + B14;
      A15:= H2*(H2*M15 + S15) + B15; A22:= H2*(H2*M22 + S22) + B22;
      A23:= H2*(H2*M23 + S23) + B23; A24:= H2*(H2*M24 + S24) + B24;
      A25:= H2*(H2*M25 + S25) + B25; A33:= H2*(H2*M33 + S33) + B33;
      A34:= H2*(H2*M34 + S34) + B34; A35:= H2*(H2*M35 + S35) + B35;
      A44:= H2*(H2*M44 + S44) + B44; A45:= H2*(H2*M45 + S45) + B45;
      A55:= H2*(H2*M55 + S55) + B55;
 
      "COMMENT" STATIC CONDENSATION;
      C1:= A15/A55; C2:= A25/A55; C3:= A35/A55; C4:= A45/A55;
      B1:= (B1 - C1*B5)*H; B2:= (B2 - C2*B5)*H2;
      B3:= (B3 - C3*B5)*H; B4:= (B4 - C4*B5)*H2;
      A11:= (A11 - C1*A15)/H3; A12:= (A12 - C1*A25)/H2;
      A13:= (A13 - C1*A35)/H3; A14:= (A14 - C1*A45)/H2;
      A22:= (A22 - C2*A25)/H; A23:= (A23 - C2*A35)/H2;
      A24:= (A24 - C2*A45)/H; A33:= (A33 - C3*A35)/H3;
      A34:= (A34 - C3*A45)/H2; A44:= (A44 - C4*A45)/H;
    "END" "ELSE"
    "BEGIN" "OWN" "REAL"P5, Q5, R5, F5;
      "REAL" X2, X3, X4, H, H2, H3,
      P1, P2, P3, P4, Q1, Q2, Q3, Q4,
      R1, R2, R3, R4, F1, F2, F3, F4,
      B11, B12, B13, B14, B15, B16, B22, B23, B24, B25, B26,
      B33, B34, B35, B36, B44, B45, B46, B55, B56, B66,
      S11, S12, S13, S14, S15, S16, S22, S23, S24, S25, S26,
      S33, S34, S35, S36, S44, S45, S46, S55, S56, S66,
      M11, M12, M13, M14, M15, M16, M22, M23, M24, M25, M26,
      M33, M34, M35, M36, M44, M45, M46, M55, M56, M66,
      C15, C16, C25, C26, C35, C36, C45, C46, B5, B6,
      A15, A16, A25, A26, A35, A36, A45, A46, A55, A56, A66, DET;
      "IF"L=1"THEN"
      "BEGIN"P5:= P(XL1); Q5:= Q(XL1); R5:= R(XL1); F5:= F(XL1)
      "END";
      H:= XL - XL1; H2:= H*H; H3:= H*H2;
      X2:= XL1 + H*.172673164646; X3:= XL1 + H/2; X4:= XL1 + XL - X2;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                     PAGE 11
                                                               ;
 
 
      "COMMENT" ELEMENT BENDING MATRIX;
      P1:= P5; P2:= P(X2); P3:= P(X3); P4:= P(X4); P5:= P(XL);
      B11:= + 105.8*P1 + 9.8*P5     + 7.3593121303513"-2*P2
            + 2.2755555555556"+1*P3 + 7.0565656088553"+0*P4;
      B12:= + 27.6*P1  + 1.4*P5     - 3.41554824811"-1*P2
            + 2.8444444444444"+0*P3 + 1.0113960946522"+0*P4;
      B13:= - 32.2*(P1 + P5)        - 7.2063492063505"-1*(P2 + P4)
            + 2.2755555555556"+1*P3;
      B14:= + 4.6*P1 + 8.4*P5       + 1.0328641222944"-1*P2
            - 2.8444444444444"+0*P3 - 3.3445562534992"+0*P4;
      B15:= - (B11 + B13); B16:= - (B12 + B13 + B14 + B15/2);
      B22:= + 7.2*P1 + 0.2*P5       + 1.5851984028581"+0*P2
            + 3.5555555555556"-1*P3 + 1.4496032730059"-1*P4;
      B23:= - 8.4*P1 - 4.6*P5       + 3.3445562534992"+0*P2
            + 2.8444444444444"+0*P3 - 1.0328641222944"-1*P4;
      B24:= + 1.2*(P1 + P5)         - 4.7936507936508"-1*(P2 + P4)
            - 3.5555555555556"-1*P3;
      B25:= - (B12 + B23); B26:= - (B22 + B23 + B24 + B25/2);
      B33:= + 7.0565656088553"+0*P2 + 2.2755555555556"+1*P3
            + 7.3593121303513"-2*P4 + 105.8*P5 + 9.8*P1;
      B34:= - 1.4*P1 - 27.6*P5      - 1.0113960946522"+0*P2
            - 2.8444444444444"+0*P3 + 3.4155482481100"-1*P4;
      B35:= - (B13 + B33); B36:= - (B23 + B33 + B34 + B35/2);
      B44:= +7.2*P5 + P1/5          + 1.4496032730059"-1*P2
            + 3.5555555555556"-1*P3 + 1.5851984028581"+0*P4;
      B45:= - (B14 + B34); B46:= - (B24 + B34 + B44 + B45/2);
      B55:= - (B15 + B35); B56:= - (B16 + B36);
      B66:= - (B26 + B36 + B46 + B56/2);
 
      "COMMENT" ELEMENT STIFFNESS MATRIX;
      Q1:= Q5; Q2:= Q(X2); Q3:= Q(X3); Q4:= Q(X4); Q5:= Q(XL);
      S11:= + 3.0242424037951"+0*Q2 + 3.1539909130065"-2*Q4;
      S12:= + 1.2575525581744"-1*Q2 + 4.1767169716742"-3*Q4;
      S13:= - 3.0884353741496"-1*(Q2+Q4);
      S14:= + 4.0899041243062"-2*Q2 + 1.2842455355577"-2*Q4;
      S15:= - (S13 + S11);
      S16:= + 5.9254861177068"-1*Q2 + 6.0512612719116"-2*Q4;
      S22:= + 5.2292052865422"-3*Q2 + 5.5310763862796"-4*Q4 + Q1/20;
      S23:= - 1.2842455355577"-2*Q2 - 4.0899041243062"-2*Q4;
      S24:= + 1.7006802721088"-3*(Q2+Q4);
      S25:= - (S12 + S23);
      S26:= + 2.4639593097426"-2*Q2 + 8.0134681270641"-3*Q4;
      S33:= + 3.1539909130065"-2*Q2 + 3.0242424037951"+0*Q4;
      S34:= - 4.1767169716742"-3*Q2 - 1.2575525581744"-1*Q4;
      S35:= - (S13 + S33);
      S36:= - 6.0512612719116"-2*Q2 - 5.9254861177068"-1*Q4;
      S44:= + 5.5310763862796"-4*Q2 + 5.2292052865422"-3*Q4 + Q5/20;
      S45:= - (S14 + S34);
      S46:= + 8.0134681270641"-3*Q2 + 2.4639593097426"-2*Q4;
      S55:= - (S15 + S35); S56:= -(S16 + S36);
      S66:= + 1.1609977324263"-1*(Q2+Q4) + 3.5555555555556"-1*Q3;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                     PAGE 12
                                                               ;
 
 
      "COMMENT" ELEMENT MASS MATRIX;
      R1:= R5; R2:= R(X2); R3:= R(X3); R4:= R(X4); R5:= R(XL);
      M11:= + 9.7107020727310"-2*R2 + 1.5810259199180"-3*R4 + R1/20;
      M12:= + 8.2354889460254"-3*R2 + 2.1932154960071"-4*R4;
      M13:= + 1.2390670553936"-2*(R2+R4);
      M14:= - 1.7188466249968"-3*R2 - 1.0508326752939"-3*R4;
      M15:= + 5.3089789712119"-2*R2 + 6.7741558661060"-3*R4;
      M16:= - 1.7377712856076"-2*R2 + 2.2173630018466"-3*R4;
      M22:= + 6.9843846173145"-4*R2 + 3.0424512029349"-5*R4;
      M23:= + 1.0508326752947"-3*R2 + 1.7188466249936"-3*R4;
      M24:= - 1.4577259475206"-4*(R2+R4);
      M25:= + 4.5024589679127"-3*R2 + 9.3971790283374"-4*R4;
      M26:= - 1.4737756452780"-3*R2 + 3.0759488725998"-4*R4;
      M33:= + 1.5810259199209"-3*R2 + 9.7107020727290"-2*R4 + R5/20;
      M34:= - 2.1932154960131"-4*R2 - 8.2354889460254"-3*R4;
      M35:= + 6.7741558661123"-3*R2 + 5.3089789712112"-2*R4;
      M36:= - 2.2173630018492"-3*R2 + 1.7377712856071"-2*R4;
      M44:= + 3.0424512029457"-5*R2 + 6.9843846173158"-4*R4;
      M45:= - 9.3971790283542"-4*R2 - 4.5024589679131"-3*R4;
      M46:= + 3.0759488726060"-4*R2 - 1.4737756452778"-3*R4;
      M55:= + 2.9024943310657"-2*(R2+R4) + 3.5555555555556"-1*R3;
      M56:= + 9.5006428402050"-3*(R4-R2);
      M66:= + 3.1098153547125"-3*(R2+R4);
 
      "COMMENT" ELEMENT LOAD VECTOR;
      F1:= F5; F2:= F(X2); F3:= F(X3); F4:= F(X4); F5:= F(XL);
      B1:= + 1.6258748099336"-1*F2 + 2.0745852339969"-2*F4 + F1/20;
      B2:= + 1.3788780589233"-2*F2 + 2.8778860774335"-3*F4;
      B3:= + 2.0745852339969"-2*F2 + 1.6258748099336"-1*F4 + F5/20;
      B4:= - 2.8778860774335"-3*F2 - 1.3788780589233"-2*F4;
      B5:= + (F2 + F4)/11.25       + 3.5555555555556"-1*F3;
      B6:= + 2.9095718698132"-2*(F4-F2);
 
      A11:= H2*(H2*M11 + S11) + B11; A12:= H2*(H2*M12 + S12) + B12;
      A13:= H2*(H2*M13 + S13) + B13; A14:= H2*(H2*M14 + S14) + B14;
      A15:= H2*(H2*M15 + S15) + B15; A16:= H2*(H2*M16 + S16) + B16;
      A22:= H2*(H2*M22 + S22) + B22; A23:= H2*(H2*M23 + S23) + B23;
      A24:= H2*(H2*M24 + S24) + B24; A25:= H2*(H2*M25 + S25) + B25;
      A26:= H2*(H2*M26 + S26) + B26; A33:= H2*(H2*M33 + S33) + B33;
      A34:= H2*(H2*M34 + S34) + B34; A35:= H2*(H2*M35 + S35) + B35;
      A36:= H2*(H2*M36 + S36) + B36; A44:= H2*(H2*M44 + S44) + B44;
      A45:= H2*(H2*M45 + S45) + B45; A46:= H2*(H2*M46 + S46) + B46;
      A55:= H2*(H2*M55 + S55) + B55; A56:= H2*(H2*M56 + S56) + B56;
      A66:= H2*(H2*M66 + S66) + B66;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.2.2.1   (JANUARY 1976)                     PAGE 13
                                                               ;
 
 
      "COMMENT" STATIC CONDENSATION;
      DET:= - A55*A66 + A56*A56;
      C15:= (A15*A66 - A16*A56)/DET; C16:= (A16*A55 - A15*A56)/DET;
      C25:= (A25*A66 - A26*A56)/DET; C26:= (A26*A55 - A25*A56)/DET;
      C35:= (A35*A66 - A36*A56)/DET; C36:= (A36*A55 - A35*A56)/DET;
      C45:= (A45*A66 - A46*A56)/DET; C46:= (A46*A55 - A45*A56)/DET;
      A11:= (A11 + C15*A15 + C16*A16)/H3;
      A12:= (A12 + C15*A25 + C16*A26)/H2;
      A13:= (A13 + C15*A35 + C16*A36)/H3;
      A14:= (A14 + C15*A45 + C16*A46)/H2;
      A22:= (A22 + C25*A25 + C26*A26)/H;
      A23:= (A23 + C25*A35 + C26*A36)/H2;
      A24:= (A24 + C25*A45 + C26*A46)/H;
      A33:= (A33 + C35*A35 + C36*A36)/H3;
      A34:= (A34 + C35*A45 + C36*A46)/H2;
      A44:= (A44 + C45*A45 + C46*A46)/H;
      B1:= (B1 + C15*B5 + C16*B6)*H; B2:= (B2 + C25*B5 + C26*B6)*H2;
      B3:= (B3 + C35*B5 + C36*B6)*H; B4:= (B4 + C45*B5 + C46*B6)*H2;
    "END"EL.MATVECEVAL.;
 
 
    L:= 1; W:= V:= 0; N2:= N + N - 2; XL1:= X[0]; XL:= X[1];
    YA:= E[1]; ZA:= E[2]; YB:= E[3]; ZB:= E[4];
    ELEMENTMATVECEVALUATION; EM[2]:= "-12;
    R1:= B3 - A13*YA - A23*ZA; D1:= A33; D2:= A44;
    R2:= B4 - A14*YA - A24*ZA; E1:= A34;
    "FOR"L:= L + 1"WHILE"L<N"DO"
    "BEGIN" XL1:= XL; XL:= X[L];
     ELEMENTMATVECEVALUATION;
     A[W + 1]:= D1 + A11; A[W + 4]:= E1 + A12;
     A[W + 7]:= A13; A[W + 10]:= A14;
     A[W + 5]:= D2 + A22; A[W + 8]:= A23;
     A[W + 11]:= A24; A[W + 14]:= 0;
     Y[V + 1]:= R1 + B1; Y[V + 2]:= R2 + B2;
     R1:= B3; R2:= B4; V:= V + 2; W:= W + 8;
     D1:= A33; D2:= A44; E1:= A34
    "END";
    L:= N; XL1:= XL; XL:= X[L]; ELEMENTMATVECEVALUATION;
    Y[N2      - 1]:= R1 + B1 - A13*YB - A14*ZB;
    Y[N2]:= R2 + B2 - A23*YB - A24*ZB;
     A[W + 1]:= D1 + A11; A[W + 4]:= E1 + A12; A[W + 5]:= D2 + A22;
    CHLDECSOLBND(A, N2, 3, EM, Y)
  "END" FEMHERM;
      "EOP"
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 1
 
 
 
 AUTHOR: M. BAKKER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 791231.
 
 
 BRIEF DESCRIPTION:
 
     THE PROCEDURE NONLIN FEMLAGSKEW SOLVES A NONLINEAR TWO POINT
     BOUNDARY VALUE PROBLEM WITH SPHERICAL COORDINATES.
     IT SOLVES THE DIFFERENTIAL EQUATION
 
         (X**NC*Y')'/X**NC = F(X, Y, Y'), A < X < B,
 
       WITH BOUNDARY CONDITIONS
 
           E[1]*Y(A) + E[2]*Y'(A) = E[3],
 
           E[4]*Y(B) + E[5]*Y'(B) = E[6].
 
 
 
 KEY WORDS AND PHRASES:
 
     SECOND ORDER DIFFERENTIAL EQUATIONS,
     TWO POINT BOUNDARY VALUE PROBLEMS,
     BOUNDARY VALUE PROBLEMS,
     RITZ-GALERKIN METHOD,
     SPHERICAL COORDINATES,
     GLOBAL METHODS.
 
 
 REFERENCES:
 
     [1]  STRANG, G. AND G.J. FIX,
          AN ANALYSIS OF THE FINITE ELEMENT METHOD,
          PRENTICE-HALL, ENGLEWOOD CLIFFS, NEW JERSEY, 1973.
 
     [2]  BAKKER, M., EDITOR,
          COLLOQUIUM ON DISCRETIZATION METHODS, CHAPTER 3 (DUTCH),
          MATHEMATISCH CENTRUM, MC-SYLLABUS 27, 1976.
 
     [3]  BABUSKA, I.,
          NUMERICAL STABILITY IN PROBLEMS OF LINEAR ALGEBRA,
          S.I.A.M.  J. NUM. ANAL., VOL.9, P. 53-77 (1972).
 
     [4]  BAKKER, M.,
          GALERKIN METHODS IN SPHERICAL REGIONS, TO APPEAR.
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 2
 
 
 
 SUBSECTION: NONLIN FEM LAG SKEW.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" NONLIN FEM LAG SKEW(X, Y, N, F, FY, FZ, NC, E);
     "INTEGER" N, NC;
     "REAL" "PROCEDURE" F, FY, FZ;
     "ARRAY" X, Y, E;
     "CODE" 33314;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1;
 
     NC:   <EXPRESSION>;
          IF NC = 0, CARTESIAN COORDINATES ARE USED;
          IF NC = 1, POLAR COORDINATES ARE USED;
          IF NC = 2, SPHERICAL COORDINATES ARE USED;
 
     X:  <ARRAY IDENTIFIER>;
         "ARRAY" X[0:N];
         ENTRY: A = X[0] < X[1] < ... < X[N] = B IS  A
         PARTITION OF THE SEGMENT [A,B];
 
     Y:  <ARRAY IDENTIFIER>;
         "ARRAY" Y[0:N];
         ENTRY: Y[I] (I = 0, 1, ... , N) IS AN INITIAL APPROXIMATE
         SOLUTION AT X[I] OF THE DIFFERENTIAL EQUATION
 
         (3)  (Y'*X**NC)'/X**NC = F(X,Y,Y')    , A < X < B,
 
         WITH BOUNDARY CONDITIONS
 
         (4)    E[1]*Y(A) + E[2]*Y'(A) = E[3],
                E[4]*Y(B) + E[5]*Y'(B) = E[6];
 
         EXIT: Y[I] (I = 0, 1, ... , N) IS THE GALERKIN
         SOLUTION AT X[I] OF THE (3)-(4);
 
     F:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF F READS:
         "REAL" "PROCEDURE" F(X,Y,Z); "VALUE" X,Y,Z; "REAL" X,Y,Z;
         F(X,Y,Z) IS THE RIGHT HAND SIDE OF (3);
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 3
 
 
 
     FY:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF FY READS:
         "REAL" "PROCEDURE" FY(X,Y,Z); "VALUE" X,Y,Z; "REAL" X,Y,Z;
         FY(X,Y,Z) IS THE DERIVATIVE OF F WITH RESPECT TO Y;
 
     FZ:  <PROCEDURE IDENTIFIER>;
         THE HEADING OF FZ READS:
         "REAL" "PROCEDURE" FZ(X,Y,Z); "VALUE" X,Y,Z; "REAL" X,Y,Z;
         FZ(X,Y,Z) IS THE DERIVATIVE OF F WITH RESPECT TO Z;
 
     E:  <ARRAY IDENTIFIER>;
         "ARRAY" E[1:6];
         E[1], ... , E[6] DESCRIBE THE BOUNDARY CONDITIONS (4);
         E[1] AND E[4] ARE NOT ALLOWED TO VANISH BOTH.
 
 
 PROCEDURES USED: DUPVEC CP 31030.
 
 
 REQUIRED CENTRAL MEMORY:
 
     FIVE AUXILIARY ARRAYS OF N REALS ARE USED.
 
 
 RUNNING TIME:
 
     LET IT BE THE NUMBER OF NEWTON ITERATIONS; THEN
     IT*N  EVALUATIONS OF F, FY, FZ ARE NEEDED;
 
 
 DATA AND RESULTS:
 
     THE FUNCTIONS F, FY AND FZ ARE REQUIRED TO BE SUFFICIENTLY
     SMOOTH IN THEIR VARIABLES ON THE INTERIOR OF EVERY SEGMENT
     <X[I],X[I+1]> (I = 0, ..., N - 1);
 
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 4
 
 
 
 METHOD AND PERFORMANCE:
 
     LET Y[0](X) BE SOME INITIAL APPROXIMATION OF Y(X); THEN
     THE NONLINEAR PROBLEM IS SOLVED BY SUCCESIVELY SOLVING
 
        - (D[K]'*X**NC)'/X**NC
 
        + FY(X,Y[K](X),Y[K]'(X))*D[K](X)
 
        + FZ(X,Y[K](X),Y[K]'(X))*D[K]'(X)
 
      =   (Y[K]'*X**NC)'/X**NC
 
        - F(X,Y[K],Y[K]'(X)), X[0] < X < X[N],
 
 
        E[1]*D[K](X[0]) + E[2]*D[K]'(X[0]) = 0;
 
        E[4]*D[K](X[N]) + E[5]*D[K]'(X[N]) = 0;
 
     WITH GALERKIN'S METHOD (SEE PREVIOUS SECTION) AND PUTTING
 
 
        Y[K+1](X) = Y[K](X) + D[K](X), K = 0,1,...
 
 
     THIS IS THE SO-CALLED NEWTON-KANTOROWITCH METHOD;
 
 EXAMPLE OF USE:
 
     WE SOLVE THE BOUNDARY VALUE PROBLEM
 
 
         (Y'*X**2)'/X**2 = EXP(Y)+EXP(Y')-EXP(1-X**2)-EXP(2*X)-6;
         0 < X < 1, Y'(0) = Y(1) = 0;
 
     FOR THE BOUNDARY CONDITIONS THIS MEANS THAT
 
         E[2] = E[4] = 1; E[1] = E[3] = E[5] = E[6] = 0;
 
     THE ANALYTIC SOLUTION IS Y(X) = 1 - X**2; WE APPROXIMATE
     THE SOLUTION ON A UNIFORM GRID, I.E. X[I] = I/N,
     I = 0, ..., N; WE CHOOSE N=10,20 AND COMPUTE THE MAXIMUM ERROR;
     THE PROGRAM READS AS FOLLOWS:
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 5
 
 
 
     "BEGIN" "INTEGER" N, NC;
     "FOR" NC:= 0,1,2 "DO"
     "FOR" N:= 25, 50 "DO"
     "BEGIN" "INTEGER" I;"ARRAY" X, Y[0:N], E[1:6]; "REAL" RHO, D;
 
         "REAL" "PROCEDURE" F(X,Y,Z); "VALUE" X,Y,Z; "REAL" X,Y,Z;
         F:= EXP(Y)+EXP(Z)-EXP(1-X**2)-EXP(-2*X)-2-2*NC;
 
         "REAL" "PROCEDURE" FY(X,Y,Z); "VALUE" X,Y,Z; "REAL" X,Y,Z;
         FY:= EXP(Y);
 
         "REAL" "PROCEDURE" FZ(X,Y,Z); "VALUE" X,Y,Z; "REAL" X,Y,Z;
         FZ:= EXP(Z);
 
         E[2]:= E[4]:= 1; E[1]:= E[3]:= E[5]:= E[6]:= 0;
         "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO"
         "BEGIN" X[I]:= I/N; Y[I]: = 0 "END";
         OUTPUT(61,"("//,4B"("N = ")"ZD,4B"("NC = ")"ZD")",N,NC);
         NONLIN FEM LAG SKEW(X, Y, N, F, FY, FZ, NC, E);
         RHO:= 0;
         "FOR" I:= 0 "STEP" 1 "UNTIL" N "DO"
         "BEGIN" D:= ABS(Y[I] - 1 + X[I]**2);
             "IF" RHO < D "THEN" RHO:= D
         "END";
         OUTPUT(61,"("24B"("MAX.ERROR= ")",D.DD"+ZD")",RHO)
     "END"
     "END"
 
     RESULTS:
 
     N = 25    NC =  0                        MAX.ERROR= 2.47" -4
 
     N = 50    NC =  0                        MAX.ERROR= 6.19" -5
 
     N = 25    NC =  1                        MAX.ERROR= 1.41" -3
 
     N = 50    NC =  1                        MAX.ERROR= 3.99" -4
 
     N = 25    NC =  2                        MAX.ERROR= 2.44" -3
 
     N = 50    NC =  2                        MAX.ERROR= 7.02" -4
 
     ONE OBSERVES THAT THE MAXIMUM ERROR DECREASES BY ABOUT
     0.25 WHEN THE MESH SIZE IS HALVED.
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 6
 
 
 
 SOURCE TEXT(S):
0"CODE" 33314;
  "PROCEDURE" NONLIN FEM LAG SKEW(X, Y, N, F, FY, FZ, NC, E);
  "INTEGER" N, NC;
  "REAL" "PROCEDURE" F, FY, FZ;
  "ARRAY" X, Y, E;
  "BEGIN" "INTEGER" L, L1, IT;
    "REAL" XL1, XL, H, A12, A21, B1, B2, TAU1, TAU2, CH, TL, G, YL, PP,
     PLM, PRM, PL1, PL3, PL1PL2, PL1PL3, PL2PL2, PL2PL3,
     PR1PR2, PR1PR3, PR2PR3, PL1QL2, PL1QL3, PL2QL1, PL2QL2, PL2QL3,
     PL3QL1, PL3QL2, PR1QR2, PR1QR3, PR2QR1, PR2QR2, PR2QR3, PR3QR1,
     PR3QR2, H2RM, ZL1, ZL, E1, E2, E3, E4, E5, E6, EPS, RHO;
    "ARRAY" T, SUPER, SUB, CHI, GI[0:N-1], Z[0:N];
 
    "PROCEDURE" ELEMENT MAT VEC EVALUATION 1;
    "BEGIN" "REAL"  XM,VL,VR,WL,WR,PR,QM,RM,FM,XL12,XL1XL,XL2,ZM,ZACCM;
     "IF" NC = 0 "THEN" VL:= VR:= 0.5 "ELSE" "IF" NC = 1 "THEN"
     "BEGIN" VL:= (XL1*2 + XL)/6; VR:= (XL1 + XL*2)/6 "END" "ELSE"
     "BEGIN" XL12:= XL1*XL1/12; XL1XL:=XL1*XL/6; XL2:=XL*XL/12;
      VL:= 3*XL12 + XL1XL + XL2;
      VR:= 3*XL2 + XL1XL + XL12
     "END";
     WL:= H*VL; WR:=H*VR; PR:= VR/(VL +VR);
     XM:= XL1 + H*PR; ZM:= PR*ZL + (1 - PR)*ZL1;
     ZACCM:= (ZL - ZL1)/H ; QM:= FZ(XM,ZM,ZACCM);
     RM:= FY(XM, ZM, ZACCM); FM:= F(XM,ZM,ZACCM);
     TAU1:= WL*RM; TAU2:=WR*RM;
     B1:= WL*FM - ZACCM*(VL +VR); B2:= WR*FM + ZACCM*(VL + VR);
     A12:= - (VL + VR)/H + VL*QM + (1 - PR)*PR*RM*(WL + WR);
     A21:= - (VL + VR)/H - VR*QM + (1 - PR)*PR*RM*(WL + WR);
    "END" ELEM. M.V. EV.;
 
 
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 7
                                                                     ;
 
 
    "PROCEDURE" BOUNDARY CONDITIONS;
    "IF" L=1 "AND" E2 = 0 "THEN"
    "BEGIN" TAU1:= 1; B1:= A12:= 0 "END"
    "ELSE" "IF" L=1 "AND" E2 ^= 0 "THEN"
    "BEGIN" TAU1:= TAU1 - E1/E2
    "END" "ELSE" "IF" L=N "AND" E5 = 0 "THEN"
    "BEGIN" TAU2:= 1; B2:= A21:= 0
    "END" "ELSE" "IF" L=N "AND" E5 ^= 0 "THEN"
    "BEGIN" TAU2:= TAU2 + E4/E5
    "END" B.C.1;
 
    "PROCEDURE" FORWARD BABUSKA;
    "IF" L=1 "THEN"
    "BEGIN" CHI[0]:= CH:= TL:= TAU1; T[0]:= TL;
       GI[0]:= G:= YL:= B1; Y[0]:= YL;
       SUB[0]:= A21; SUPER[0]:= A12;
       PP:= A21/(CH - A12); CH:= TAU2 - CH*PP;
       G:= B2 - G*PP; TL:= TAU2; YL:= B2
    "END" "ELSE"
    "BEGIN" CHI[L1]:= CH:= CH + TAU1;
       GI[L1]:= G:= G + B1;
       SUB[L1]:= A21; SUPER[L1]:= A12;
       PP:= A21/(CH - A12); CH:= TAU2 - CH*PP;
       G:= B2 - G*PP; T[L1]:= TL + TAU1; TL:= TAU2;
       Y[L1]:= YL +  B1; YL:= B2
    "END" FORWARD BABUSKA;
 
    "PROCEDURE" BACKWARD BABUSKA;
    "BEGIN"PP:= YL; Y[N]:= G/CH;
       G:= PP; CH:= TL; L:= N;
       "FOR" L:= L - 1 "WHILE" L >= 0 "DO"
       "BEGIN" PP:= SUPER[L]/(CH - SUB[L]);
         TL:= T[L]; CH:= TL - CH*PP;
         YL:= Y[L]; G:= YL - G*PP;
         Y[L]:=(GI[L] + G - YL)/(CHI[L] + CH - TL)  ;
       "END"
    "END" BACKWARD BABUSKA;
                                                             "COMMENT"
1SECTION : 5.2.1.2.1.3        (DECEMBER 1979)                     PAGE 8
                                                                     ;
 
 
    DUPVEC(0,N,0,Z,Y);
     E1:= E[1]; E2:= E[2]; E3:= E[3]; E4:= E[4]; E5:= E[5]; E6:= E[6];
    "FOR" IT:= 1, IT + 1 "WHILE" EPS > RHO "DO"
    "BEGIN" L:= 0;XL:= X[0]; ZL:= Z[0];
     "FOR" L:= L + 1 "WHILE" L <= N "DO"
     "BEGIN" XL1:= XL; L1:= L - 1; XL:= X[L]; H:= XL - XL1;
       ZL1:= ZL; ZL:= Z[L];
       ELEMENT MAT VEC EVALUATION 1;
       "IF" L=1 "OR" L=N "THEN" BOUNDARY CONDITIONS;
       FORWARD BABUSKA
     "END";
     BACKWARD BABUSKA;
     EPS:= 0; RHO:= 1;
     "FOR" L:= 0 "STEP" 1 "UNTIL" N "DO"
     "BEGIN" RHO:= RHO + ABS(Z[L]);
      EPS:= EPS + ABS(Y[L]); Z[L]:= Z[L] - Y[L]
     "END";
     RHO:= "-14*RHO
    "END";
     DUPVEC(0,N,0,Y,Z)
  "END" NONLIN FEM LAG SKEW;
       "EOP"
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 1
 
 
 
 AUTHORS: T.M.T.COOLEN AND R.PLOEGER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 740301.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS TWO PROCEDURES :
 
     RICHARDSON SOLVES A SYSTEM OF LINEAR EQUATIONS WITH A COEFFICIENT
     MATRIX HAVING POSITIVE REAL EIGENVALUES BY MEANS OF A NON-
     STATIONARY SECOND ORDER ITERATIVE METHOD: RICHARDSON'S METHOD.
     SINCE RICHARDSON'S METHOD IS PARTICULARLY SUITABLE FOR SOLVING
     A SYSTEM OF LINEAR EQUATIONS THAT IS OBTAINED BY DISCRETIZING A
     TWO-DIMENSIONAL ELLIPTIC BOUNDARY VALUE PROBLEM, THE PROCEDURE
     RICHARDSON IS PROGRAMMED IN SUCH A WAY THAT THE SOLUTION VECTOR
     IS GIVEN AS A TWO-DIMENSIONAL ARRAY U[J,L], LJ<=J<=UJ, LL<=L<=UL.
     THE COEFFICIENT MATRIX IS NOT STORED, BUT EACH ROW CORRESPONDING
     TO A PAIR (J,L) IS GENERATED WHEN NEEDED.
     RICHARSON CAN ALSO BE USED TO DETERMINE THE EIGENVALUE OF THE
     COEFFICIENT MATRIX CORRESPONDING TO THE DOMINANT EIGENFUNCTION.
 
     ELIMINATION, USED IN CONNECTION WITH THE PROCEDURE RICHARDSON,
     (THIS  SECTION)  SOLVES  A  SYSTEM  OF  LINEAR   EQUATIONS  WITH
     A  COEFFICIENT   MATRIX   HAVING   POSITIVE    REAL
     EIGENVALUES BY MEANS OF A NON-STATIONARY SECOND ORDER ITERATIVE
     METHOD, WHICH IS AN ACCELERATION OF RICHARDSON'S METHOD. IN
     GENERAL, ELIMINATION CANNOT BE USED BY ITSELF IN A SENSIBLE WAY.
     SINCE RICHARDSON'S METHOD AND ITS ACCELERATION ARE PARTICULARLY
     SUITABLE FOR SOLVING A SYSTEM OF LINEAR EQUATIONS THAT IS OBTAINED
     BY DISCRETIZING A TWO-DIMENSIONAL ELLIPTIC BOUNDARY VALUE PROBLEM,
     THE PROCEDURES RICHARDSON AND ELIMINATION ARE PROGRAMMED IN SUCH A
     WAY THAT THE SOLUTION VECTOR IS GIVEN AS A TWO-DIMENSIONAL ARRAY
     U[J,L], LJ<=J<=UJ, LL<=L<=UL. THE COEFFICIENT MATRIX IS NOT STORED,
     BUT EACH ROW CORRESPONDING TO A PAIR(J,L) IS GENERATED WHEN NEEDED.
 
 KEYWORDS:
 
     DIFFERENTIAL EQUATION,
     TWO-DIMENSIONAL BOUNDARY VALUE PROBLEM,
     SYSTEM OF LINEAR EQUATIONS,
     COEFFICIENT MATRIX HAVING POSITIVE REAL EIGENVALUES,
     NON-STATIONARY SECOND ORDER ITERATIVE METHOD,
     RICHARDSON'S METHOD.
     ACCELERATION OF RICHARDSON'S METHOD.
 
 
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 2
 
 
 
 SUBSECTION : RICHARDSON.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" RICHARDSON(U,LJ,UJ,LL,UL,INAP,RESIDUAL,A,B,N,DISCR,K,
     RATECONV,DOMEIGVAL,OUT);
     "VALUE" LJ,UJ,LL,UL,A,B;
     "INTEGER" N,K,LJ,UJ,LL,UL;
     "REAL" A,B,RATECONV,DOMEIGVAL;
     "BOOLEAN" INAP;
     "ARRAY" U,DISCR;
     "PROCEDURE" RESIDUAL, OUT;
     "CODE" 33170;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     U:      <ARRAY IDENTIFIER>;
             "ARRAY" U[LJ:UJ,LL:UL];
             AFTER EACH ITERATION THE APPROXIMATE SOLUTION CALCULATED BY
             THE PROCEDURE RICHARDSON IS STORED INTO U.
             ENTRY: IF INAP IS CHOSEN TO BE "TRUE" THEN AN INITIAL
                    APPROXIMATION OF THE SOLUTION, OTHERWISE ARBITRARY;
             EXIT: THE FINAL APPROXIMATION OF THE SOLUTION;
     LJ,UJ:  <ARITHMETIC EXPRESSION>;
             LOWER AND UPPER BOUND FOR THE FIRST SUBSCRIPT OF U;
     LL,UL:  <ARITHMETIC EXPRESSION>;
             LOWER AND UPPER BOUND FOR THE SECOND SUBSCRIPT OF U;
     INAP:   <BOOLEAN EXPRESSION>;
             IF THE USER WISHES TO INTRODUCE AN INITIAL APPROXIMATION
             INAP="TRUE" SHOULD BE CHOSEN; THE CHOICE INAP="FALSE" HAS
             THE EFFECT THAT ALL COMPONENTS OF U ARE SET EQUAL TO 1
             BEFORE THE FIRST ITERATION IS PERFORMED;
     RESIDUAL: <PROCEDURE IDENTIFIER>;
             THE HEADING OF THIS PROCEDURE READS :
             "PROCEDURE" RESIDUAL(U); "ARRAY" U;
             SUPPOSE THAT THE SYSTEM OF EQUATIONS AT HAND IS AU= F;
             FOR ANY ENTRY U THE PROCEDURE RESIDUAL SHOULD CALCULATE
             THE  RESIDUAL  AU - F  IN  EACH  POINT  J,L,  WHERE
             LJ<=J<=UJ, LL<=L<=UL, AND SUBSTITUTE THESE VALUES IN THE
             ARRAY U;
     A,B:    <ARITHMETIC EXPRESSION>;
             IF ONE WISHES TO FIND THE SOLUTION OF THE BOUNDARY VALUE
             PROBLEM, IN  A  AND  B  THE USER SHOULD GIVE A LOWER AND
             UPPER BOUND FOR THE EIGENVALUES FOR WHICH THE CORRESPONDING
             EIGENFUNCTIONS IN THE EIGENFUNCTION EXPANSION OF THE RESIDU
             AL AU - F, WITH U = THE INITIAL APPROXIMATION, SHOULD BE
             REDUCED; IF THE DOMINANT EIGENVALUE IS TO BE FOUND, ONE
             SHOULD CHOOSE  A  GREATER THAN THIS EIGENVALUE
             (SEE METHOD AND PERFORMANCE);
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 3
 
 
 
     N:      <ARITHMETIC EXPRESSION>;
             N GIVES THE TOTAL NUMBER OF ITERATIONS TO BE PERFORMED; THE
             VALUE OF N SHOULD EITHER BE GIVEN, OR MADE DEPENDENT OF
             SOME JENSEN PARAMETER; E.G. K AND RATECONV CAN SERVE
             FOR THIS PURPOSE;
     DISCR:  <ARRAY IDENTIFIER>;
             "ARRAY" DISCR[1:2];
             AFTER EACH ITERATION THE PROCEDURE RICHARDSON DELIVERS
             IN DISCR[1] THE EUCLIDEAN NORM OF THE RESIDUAL, AND
             IN DISCR[2] THE MAXIMUM NORM OF THE RESIDUAL;
     K:      <VARIABLE>
             K COUNTS THE NUMBER OF ITERATIONS RICHARDSON IS PERFORMING;
             IT CAN SERVE AS A JENSEN PARAMETER FOR N AND OUT;
     RATECONV: <VARIABLE>;
             AFTER EACH ITERATION THE AVERAGE RATE OF CONVERGENCE IS
             ASSIGNED TO RATECONV;
     DOMEIGVAL: <VARIABLE>;
             AFTER EACH ITERATION THE VALUE OF THE DOMINANT EIGENVALUE,
             IF PRESENT, IS ASSIGNED TO DOMEIGVAL; IF THERE IS NO
             DOMINANT EIGENVALUE, THE VALUE OF DOMEIGVAL IS MEANINGLESS,
             WHICH MANIFESTS ITSELF BY SHOWING NO CONVERGENCE TO A
             FIXED VALUE;
     OUT:    <PROCEDURE IDENTIFIER>;
             THE HEADING OF THIS PROCEDURE, TO BE WRITTEN BY THE USER,
             READS :
             "PROCEDURE" OUT(K); "VALUE" K; "INTEGER"K;
             BY THIS PROCEDURE ONE HAS ACCESS TO THE FOLLOWING
             QUANTITIES:
             FOR 0<=K<=N THE K-TH ITERAND IN U,THE EUCLIDEAN AND
             MAXIMUM NORM OF THE K-TH RESIDUAL IN DISCR[1] AND DISCR[2],
             RESPECTIVELY;
             FOR 0<K<=N ALSO THE AVERAGE RATE OF CONVERGENCE AND THE
             APPROXIMATION TO THE DOMINANT EIGENVALUE, BOTH WITH RESPECT
             TO THE K-TH ITERAND U, IN RATECONV AND DOMEIGVAL,
             RESPECTIVELY;
             MOREOVER, OUT CAN BE USED TO LET N BE DEPENDENT ON THE
             ACCURACY REACHED IN APPROXIMATING THE DOMINANT EIGENVALUE.
 
 
 DATA AND RESULTS: SEE REF[1],[2].
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
 
     APPROXIMATELY  3*(UJ - LJ + 1) * (UL - LL + 1) WORDS.
 
 
 
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 4
 
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
 
     SUPPOSE THE SYSTEM OF EQUATIONS TO BE SOLVED READS AU = F, WHERE
     A IS A MATRIX HAVING POSITIVE REAL EIGENVALUES. DENOTING THE
     K-TH ITERATE BY  U(K), U(K) BEING THE VECTOR  U(K)[J,L], LJ<=J<=UJ,
     LL<=L<=UL, THE SO-CALLED RESIDUAL WITH RESPECT TO THE K-TH ITERATE
     IS DEFINED BY
             R(K) = AU(K) - F.
     A SECOND ORDER NON-STATIONARY ITERATIVE METHOD IS GIVEN BY
             U(K+1) = BETA K * U(K) + (1 - BETA K) * U(K-1)
                      - OMEGA K * R(K),
     OR, EQUIVALENTLY, IF U IS THE (UNKNOWN) EXACT SOLUTION OF AU = F,
             U(K) - U = PK(A) (U(0) - U),
     WHERE PK DENOTES A POLYNOMIAL OF DEGREE K. RICHARDSON'S METHOD
     CONSISTS OF CHOOSING THIS POLYNOMIAL IN SUCH A WAY THAT AMONGST ALL
     POLYNOMIALS  PK(X) OF DEGREE K WITH PK(0)= 1 IT HAS MINIMAL MAXIMUM
     NORM OVER THE INTERVAL [C,D], WHERE  C > 0 SHOULD BE CHOSEN TO BE A
     LOWER BOUND, AND D AN UPPER BOUND FOR THE EIGENVALUES OF  A.
     APPLICATION OF THIS POLYNOMIAL TO THE INITIAL ERROR  U(0) - U  HAS
     THE EFFECT THAT EACH COMPONENT OF THE INITIAL ERROR IN ITS EIGEN-
     FUNCTION EXPANSION IS REDUCED BY A FACTOR LESS OR EQUAL TO THE NORM
     OF THE POLYNOMIAL.
     THE POLYNOMIALS
             PK(X) = CK((A+B-2*X)/(A-B)) / CK((A+B)/(A-B))
     WHERE CK(Y) DENOTES THE K-TH CHEBYSHEV POLYNOMIAL, HAVE THE
     DESIRED PROPERTIES. THUS, THE VALUES OF THE PARAMETERS BETA K
     AND OMEGA K MAY BE DETERMINED FROM THE RECURRENCE RELATIONS FOR
     CHEBESHEV POLYNOMIALS.
     IN COMPUTATION U(K) - U  IS NOT AVAILABLE, SO ONE USES R(K) AS
     A MEASURE FOR THE ERROR.
 
     THE  ELEMENTS  OF  THE  MATRIX  A  ARE  NOT  STORED,  BUT
     GENERATED WHEN NEEDED. MORE PRECISELY, THIS MEANS THAT THE
     (UJ-LJ+1) * (UL-LL+1) COMPONENTS OF  AU(K) - F  ARE CALCULATED FOR
     EACH PAIR (J,L)  LJ<J<UJ, LL<L<UL. THE USER SHOULD INTRODUCE THE
     EQUATION TO BE SOLVED IN THIS MANNER BY MEANS OF THE PROCEDURE
     RESIDUAL.
     CLEARLY, THE METHOD IS PARTICULARLY SUITABLE FOR SPARSE MATRICES,
     FOR EXAMPLE MATRICES THAT ARE OBTAINED BY DISCRETIZING ELLIPTIC
     PARTIAL DIFFERENTIAL EQUATIONS.
     THE SHARPER THE BOUNDS  C  AND  D  FOR THE EIGENVALUES 0F  A ARE,
     THE BETTER APPROXIMATE SOLUTION ONE GETS FOR A GIVEN VALUE OF  K,
     SINCE THE ASYMPTOTIC RATE OF CONVERGENCE (K TO INFINITY) IS
     2 * SQRT(C/D).
 
     NOW LET ALPHA1 BE THE SMALLEST EIGENVALUE OF  A. IF ONE CHOOSES
     C > ALPHA1, THEN, STARTING WITH ANY INITIAL APPROXIMATION, FOR A
     SUFFICIENTLY LARGE NUMBER OF ITERATIONS THE PROCEDURE RICHARDSON
     WILL DELIVER AN APPROXIMATE VALUE FOR THIS EIGENVALUE.
 
1SECTION : 5.2.1.2.2.1.2      (OCTOBER 1974)                      PAGE 5
 
 
 
     LET US EXPLAIN THIS FACT FOR THE CASE  ALPHA1 < C < ALPHA2, WHERE
     ALPHA2  IS THE SECOND SMALLEST EIGENVALUE OF  A. THE POLYNOMIAL
     PK(X)  HAS SMALL MAXIMUM VALUE OVER THE INTERVAL [C,D] (WHICH, OF
     COURSE, DEPENDS ON  K), BUT BECOMES LARGE FOR  X < A. SO, IF ONE
     APPLIES PK(A) TO AN EIGENFUNCTION OF A, THIS EIGENFUNCTION WILL
     ONLY BE REDUCED CONSIDERABLY IF IT CORRESPONDS TO AN EIGENVALUE
     > C.  CONSEQUENTLY, THE EIGENFUNCTION CORRESPONDING TO  ALPHA1 WILL
     BECOME DOMINANT IN THE EIGENFUNCTION EXPANSION OF
             PK(A) (U(0) - U)
     FOR SUFFICIENTLY LARGE K.
 
     SEE REF[1],[2] FOR DETAILS.
 
 
 REFERENCES:
 
     [1].T.M.T.COOLEN, P.W.HEMKER, P.J.VAN DER HOUWEN  AND
         E.SLAGT.
         ALGOL 60 PROCEDURES FOR INITIAL AND BOUNDARY VALUE PROBLEMS
         (DUTCH).
         MC-SYLLABUS 20, MATHEMATICAL CENTRE, 1973, AMSTERDAM.
 
     [2].P.J.VAN DER HOUWEN.
         FINITE DIFFERENCE METHODS FOR SOLVING PARTIAL DIFFERENTIAL
         EQUATIONS.
         MATHEMATICAL CENTRE TRACT NO. 20, 1968.
 
 
 EXAMPLE OF USE:
 
     THE APPROXIMATE SOLUTION OF THE BOUNDARY VALUE PROBLEM
         - ((D/DX)**2 + (D/DY)**2) U(X,Y) = -2*(X*X+Y*Y), O<X,Y<PI,
         U(X,0) = 0, U(X,PI) = PI*PI*X*X,  0 < X < PI,
         U(0,Y) = 0, U(PI,Y) = PI*PI*X*X,  0 < Y < PI,
     WHICH HAS THE ANALYTICAL SOLUTION X*X*Y*Y, MAY BE OBTAINED BY THE
     FOLLOWING PROGRAM:
 
 "BEGIN" "COMMENT" DIRICHLET PROBLEM FOR LAPLACE'S EQUATION;
 
   "PROCEDURE" RESIDUAL(U); "ARRAY" U;
   "BEGIN" "INTEGER" UJMIN1,ULMIN1,LJPLUS1;
   "REAL" U2; "REAL" "ARRAY" U1[LJ:UJ];
     UJMIN1:= UJ - 1; ULMIN1 := UL - 1; LJPLUS1:= LJ + 1;
     "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
     "BEGIN" U1[J]:= U[J,LL]; U[J,LL]:= 0; "END";
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 6
 
 
 
     "FOR" L:= LL + 1 "STEP" 1 "UNTIL" ULMIN1 "DO"
     "BEGIN"  U1[LJ]:= U[LJ,L]; U[LJ,L]:= 0;
       "FOR"  J:= LJPLUS1"STEP" 1 "UNTIL" UJMIN1 "DO"
       "BEGIN" U2:= U[J,L];
         U[J,L]:=(4 * U2 - U1[J-1]  - U1[J] - U[J+1,L] - U[J,L+1])
         - F(J*H,L*H)*H2;
         U1[J]:= U2
       "END";
       U[UJ,L]:= 0;
     "END";
     "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO" U[J,UL]:= 0
   "END" RESIDUAL;
 
   "REAL" "PROCEDURE" F(X,Y); "VALUE" X,Y; "REAL" X,Y;
   F:= -2*(X*X + Y*Y);
 
   "REAL" "PROCEDURE" ANALSOL(X,Y); "VALUE" X,Y; "REAL" X,Y;
   ANALSOL:= X*X*Y*Y;
 
   "PROCEDURE" INITAPPR(U,J,L,G); "INTEGER" J,L; "ARRAY" U; "REAL" G;
   "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
   "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO"
   U[J,L]:= "IF" J=LJ "OR" J=UJ "OR" L=LL "OR" L=UL "THEN"G "ELSE" 1;
 
   "PROCEDURE"OUT1(K); "VALUE" K; "INTEGER" K;
   "IF" K = N "THEN" OUTPUT(61,"("//"("  K   DISCR[1]       DISCR[2]
   RATECONV")",//,+ZDB,3(+.7D"+ZDB)")",K,DISCR[1],DISCR[2],RATECONV);
   "INTEGER" J,L,LJ,UJ,LL,UL,N,K;
   "REAL" H,PI,D1,D2,H2,DOMEIGVAL,RATECONV,A,B;
   "REAL" "ARRAY" DISCR[1:2];
   OUTPUT(61,"("/"("GIVE LJ,UJ,LL,UL,N,A,B")"/")");
   ININTEGER(70,LJ); ININTEGER(70,UJ);
   ININTEGER(70,LL); ININTEGER(70,UL);
   ININTEGER(70,N); INREAL(70,A); INREAL(70,B);
 
   "BEGIN" "REAL" "ARRAY" U[LJ:UJ,LL:UL];
     PI:=3.1415 92653 58979; H:= PI/(UJ - LJ); H2:= H * H;
     INITAPPR(U,J,L,ANALSOL(J*H,L*H));
     RICHARDSON(U,LJ,UJ,LL,UL,"TRUE",RESIDUAL,A,B,N,DISCR,K,
     RATECONV ,DOMEIGVAL,OUT1);
   "END"
 "END"
 
     IT DELIVERS WITH
     LJ = 0, UJ = 11, LL = 0, UL = 11, N = 50, A = .163, B = 7.83
     THE FOLLOWING RESULTS:
 
    K   DISCR[1]      DISCR[2]      RATECONV
 
  +50 +.1401828" -3 +.4666866" -4 +.2921718" +0  .
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 7
 
 
 
 SUBSECTION : ELIMINATION.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" ELIMINATION(U,LJ,UJ,LL,UL,RESIDUAL,A,B,N,DISCR,K,
     RATECONV,DOMEIGVAL,OUT);
     "VALUE" LJ,UJ,LL,UL,A,B;
     "INTEGER" N,K,LJ,UJ,LL,UL;
     "REAL" A,B,RATECONV,DOMEIGVAL;
     "ARRAY" U,DISCR;
     "PROCEDURE" RESIDUAL, OUT; "CODE" 33171;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     U:      <ARRAY IDENTIFIER>;
             "ARRAY" U[LJ:UJ,LL:UL];
             AFTER EACH ITERATION THE APPROXIMATE SOLUTION CALCULATED BY
             THE PROCEDURE ELIMINATION IS STORED INTO U;
             ENTRY: AN INITIAL APPROXIMATION OF THE SOLUTION, WHICH
                    IS OBTAINED BY USE OF RICHARDSON;
             EXIT: THE FINAL APPROXIMATION OF THE SOLUTION;
     LJ,UJ:  <ARITHMETIC EXPRESSION>;
             LOWER AND UPPER BOUND FOR THE FIRST SUBSCRIPT OF U;
     LL,UL:  <ARITHMETIC EXPRESSION>;
             LOWER AND UPPER BOUND FOR THE SECOND SUBSCRIPT OF U;
     RESIDUAL: <PROCEDURE IDENTIFIER>;
             THE HEADING OF THIS PROCEDURE READS :
             "PROCEDURE" RESIDUAL(U); "ARRAY" U;
             SUPPOSE THAT THE SYSTEM OF EQUATIONS AT HAND IS AU= F;
             FOR ANY ENTRY U THE PROCEDURE RESIDUAL SHOULD CALCULATE
             THE SO-CALLED RESIDUAL AU - F IN EACH POINT J,L, WHERE
             LJ<=J<=UJ, LL<=L<=UL, AND SUBSTITUTE THESE VALUES IN THE
             ARRAY U;
     A,B:    <ARITHMETIC EXPRESSION>;
             A AND B SHOULD HAVE THE SAME VALUES AS IN THE PRECEDING
             CALL OF RICHARDSON (SEE DESCRIPTION OF RICHARDSON);
     N:      <VARIABLE>;
             THE NUMBER OF ITERATIONS THE PROCEDURE ELIMINATION NEEDS
             TO ELIMINATE THE EIGENFUNCTION BELONGING TO THE DOMINANT
             EIGENVALUE, IS ASSIGNED TO N;
     DISCR:  <ARRAY IDENTIFIER>;
             "ARRAY" DISCR[1:2];
             AFTER EACH ITERATION THE PROCEDURE  ELIMINATION DELIVERS
             IN DISCR[1] THE EUCLIDEAN NORM OF THE RESIDUAL, AND
             IN DISCR[2] THE MAXIMUM NORM OF THE RESIDUAL;
     K:      <VARIABLE>
             K COUNTS THE NUMBER OF ITERATIONS ELIMINATION IS PERFORMING
             IT CAN SERVE AS A JENSEN PARAMETER FOR OUT;
     RATECONV: <VARIABLE>;
             AFTER EACH ITERATION THE AVERAGE RATE OF CONVERGENCE IS
             ASSIGNED TO RATECONV;
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 8
 
 
 
     DOMEIGVAL: <ARITHMETIC EXPRESSION>;
             BEFORE A CALL OF ELIMINATION THE VALUE OF THE EIGENVALUE
             FOR WHICH THE CORRESPONDING EIGENFUNCTION HAS TO BE
             ELIMINATED, SHOULD BE ASSIGNED TO DOMEIGVAL; IF AFTER
             APPLICATION OF ELIMINATION THERE IS A NEW DOMINANT EIGEN-
             FUNCTION, THEN DOMEIGVAL WILL BE EQUAL TO THE CORRESPOND-
             ING EIGENVALUE; OTHERWISE, THE VALUE OF DOMEIGVAL BECOMES
             MEANINGLESS;
     OUT:    <PROCEDURE IDENTIFIER>;
             THE HEADING OF THIS PROCEDURE, TO BE WRITTEN BY THE USER,
             READS :
             "PROCEDURE" OUT(K); "VALUE" K; "INTEGER"K;
             BY THIS PROCEDURE ONE HAS ACCESS TO THE FOLLOWING
             QUANTITIES:
             FOR 0<=K<=N THE K-TH ITERAND IN U,THE EUCLIDEAN AND
             MAXIMUM NORM OF THE K-TH RESIDUAL IN DISCR[1] AND DISCR[2],
             RESPECTIVELY;
             FOR 0<K<=N ALSO THE AVERAGE RATE OF CONVERGENCE WITH
             RESPECT TO THE K-TH ITERAND U, IN RATECONV;
             FOR K = N, POSSIBLY THE DOMINANT EIGENVALUE OF THE
             COEFFICIENT MATRIX OF THE EQUATION AU= F, IN DOMEIGVAL.
 
 
 DATA AND RESULTS: SEE REF[1],[2].
 
 
 PROCEDURES USED:
 
     RICHARDSON = CP33170,
     TAN = CP35120,
     TANH = CP35113,
     ARCCOS = CP35122,
     ZEROIN = CP34150.
 
 
 REQUIRED CENTRAL MEMORY:
 
     APPROXIMATELY  3*(UJ - LJ + 1) * (UL - LL + 1) WORDS.
 
 
1SECTION : 5.2.1.2.2.1.2      (DECEMBER 1979)                     PAGE 9
 
 
 
 METHOD AND PERFORMANCE:
 
     SEE THIS HEADING IN THE DESCRIPTION OF THE PROCEDURE RICHARDSON.
     SOME ADDITIONAL REMARKS WILL BE MADE HERE.
     IN ORDER TO USE ELIMINATION THE INITIAL APPROXIMATION OF THE
     SOLUTION OF
             AU = F
     IS FIRST TREATED BY MEANS OF RICHARDSON'S METHOD, WHERE  C  IS
     CHOSEN GREATER THAN THE SMALLEST EIGENVALUE. AFTER APPLICATION OF
     RICHARDSON, THE EIGENFUNCTION CORRESPONDING TO THIS EIGENVALUE HAS
     BECOME DOMINANT IN THE QUANTITY
             PK(A) (U(0) - U),
     WITH
             PK(X) = CK((C+D-2*X)/(C-D)) / CK((C+D)/(C-D)),
     WHEREAS THE CONTRIBUTION OF THE OTHER EIGENFUNCTIONS TO THE ERROR
     U(K) - U  AND TO R(K) HAS BEEN REDUCED CONSIDERABLY. CONSEQUENTLY
     THE ERROR U(K) - U HAS VERY SMALL COMPONENTS IN THE SUBSPACE
     SPANNED BY ALL EIGENVECTORS BUT THE "FIRST", IN WHICH DIRECTION IT
     HAS A VERY LARGE COMPONENT.
     THE CONTRIBUTION OF THE "FIRST" EIGENFUNCTION TO  R(K)  IS NOW
     "ELIMINATED" BY APPLICATION OF A POLYNOMIAL OPERATOR E(A) SUCH
     THAT E(X) HAS A ZERO IN THE FIRST EIGENVALUE.
     THE POLYNOMIAL IS CHOSEN IN SUCH A WAY THAT A MAXIMAL RATE OF CON-
     VERGENCE WITH RESPECT TO THE INITIAL APPROXIMATION USED IN
     RICHARDSON IS OBTAINED.
 
     FOR DETAILS SEE REF[1],[2].
 
 
 REFERENCES:
 
     [1].T.M.T.COOLEN, P.W.HEMKER, P.J.VAN DER HOUWEN  AND
         E.SLAGT.
         ALGOL 60 PROCEDURES FOR INITIAL AND BOUNDARY VALUE PROBLEMS
         (DUTCH).
         MC-SYLLABUS 20, MATHEMATICAL CENTRE, 1976, AMSTERDAM.
 
     [2].P.J.VAN DER HOUWEN.
         FINITE DIFFERENCE METHODS FOR SOLVING PARTIAL DIFFERENTIAL
         EQUATIONS.
         MATHEMATICAL CENTRE TRACT NO. 20, 1968.
 
 
 EXAMPLE OF USE:
 
     THE APPROXIMATE SOLUTION OF THE BOUNDARY VALUE PROBLEM
         - ((D/DX)**2 + (D/DY)**2) U(X,Y) = -2*(X*X+Y*Y), O<X,Y<PI,
         U(X,0) = 0, U(X,PI) = PI*PI*X*X,  0 < X < PI,
         U(0,Y) = 0, U(PI,Y) = PI*PI*X*X,  0 < Y < PI,
     WHICH HAS THE ANALYTICAL SOLUTION X*X*Y*Y, MAY BE OBTAINED BY THE
     FOLLOWING PROGRAM:
 
1SECTION : 5.2.1.2.2.1.2      (OCTOBER 1974)                     PAGE 10
 
 
 
 "BEGIN" "COMMENT" DIRICHLET PROBLEM FOR LAPLACE'S EQUATION;
 
   "PROCEDURE" RESIDUAL(U); "ARRAY" U;
   "BEGIN" "INTEGER" UJMIN1,ULMIN1,LJPLUS1;
   "REAL" U2; "REAL" "ARRAY" U1[LJ:UJ];
     UJMIN1:= UJ - 1; ULMIN1 := UL - 1; LJPLUS1:= LJ + 1;
     "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
     "BEGIN" U1[J]:= U[J,LL]; U[J,LL]:= 0; "END";
     "FOR" L:= LL + 1 "STEP" 1 "UNTIL" ULMIN1 "DO"
     "BEGIN"  U1[LJ]:= U[LJ,L]; U[LJ,L]:= 0;
       "FOR"  J:= LJPLUS1"STEP" 1 "UNTIL" UJMIN1 "DO"
       "BEGIN" U2:= U[J,L];
         U[J,L]:=(4 * U2 - U1[J-1]  - U1[J] - U[J+1,L] - U[J,L+1])
         - F(J*H,L*H)*H2;
         U1[J]:= U2
       "END";
       U[UJ,L]:= 0;
     "END";
     "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO" U[J,UL]:= 0
   "END" RESIDUAL;
 
   "REAL" "PROCEDURE" F(X,Y); "VALUE" X,Y; "REAL" X,Y;
   F:= -2*(X*X + Y*Y);
 
   "REAL" "PROCEDURE" ANALSOL(X,Y); "VALUE" X,Y; "REAL" X,Y;
   ANALSOL:= X*X*Y*Y;
 
   "PROCEDURE" INITAPPR(U,J,L,G); "INTEGER" J,L; "ARRAY" U; "REAL" G;
   "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
   "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO"
   U[J,L]:= "IF" J=LJ "OR" J=UJ "OR" L=LL "OR" L=UL "THEN"G "ELSE" 1;
 
   "PROCEDURE"OUT3(K); "VALUE" K; "INTEGER" K;
   "IF" K=P "THEN" OUTPUT(61,"("//,+ZDB,3(+.7D"+ZDB)")",K,DISCR[1],
   DISCR[2],RATECONV);
 
   "PROCEDURE"OUT1(K); "VALUE" K; "INTEGER" K;
   "IF" K=N "THEN" OUTPUT(61,"("//"("  K   DISCR[1]      DISCR[2]")",
   "("      RATECONV")",//,+ZDB,3(+.7D"+ZDB)")",
      K,DISCR[1],DISCR[2],RATECONV);
 
   "PROCEDURE" OUT2(K); "VALUE" K; "INTEGER" K;
   "BEGIN"
     "IF" K = 0 "THEN" D1:= D2:= 1 "ELSE"
     "BEGIN" D2:= D1; D1:= DOMEIGVAL;
       N:= "IF" ABS((D1 - D2)/D2) < 10.0**(-Q) "THEN" K "ELSE" NN;
       OUT1(K)
     "END"
   "END" OUT2;
1SECTION : 5.2.1.2.2.1.2      (OCTOBER 1974)                     PAGE 11
 
 
 
   "INTEGER" J,L,LJ,UJ,LL,UL,NN,N,P,K,Q;
   "REAL" H,PI,D1,D2,H2,RATECONVR,RATECONVE,DOMEIGVAL,RATECONV,A,B,VAR;
   "REAL" "ARRAY" DISCR[1:2];
   OUTPUT(61,"("/"("GIVE LJ,UJ,LL,UL,N,Q,A,B")"/")");
   ININTEGER(70,LJ); ININTEGER(70,UJ);
   ININTEGER(70,LL); ININTEGER(70,UL);
   ININTEGER(70, N); ININTEGER(70, Q);
   INREAL(70, A); INREAL(70, B);
 
   "BEGIN" "REAL" "ARRAY" U[LJ:UJ,LL:UL];
     PI:=3.1415 92653 58979; H:= PI/(UJ - LJ); H2:= H * H;
     INITAPPR(U,J,L,ANALSOL(J*H,L*H));
     NN:= N;
     RICHARDSON(U,LJ,UJ,LL,UL,"TRUE",RESIDUAL,A,B,N,DISCR,K,
     RATECONV ,DOMEIGVAL,OUT2); RATECONVR:= RATECONV;
     OUTPUT(61,"("//+.7D"+ZD4B"("DOMINANT EIGENVALUE")"")",DOMEIGVAL);
     ELIMINATION(U,LJ,UJ,LL,UL,RESIDUAL,A ,B,P,DISCR,K,
     RATECONV ,DOMEIGVAL,OUT3); RATECONVE:= RATECONV;
     NN:= N + P; OUTPUT(61,"("//+Z2D13B"("TOTAL NUMBER OF ITERATIONS")"
     ")",NN);
     OUTPUT(61,"("/+.7D"+ZD4B"("RATE OF CONVERGENCE WITH RESPECT TO")",
     /17B"("THE ZEROTH ITERAND OF RICHARDSON")"")",
     (N * RATECONVR + P * RATECONVE)/NN);
   "END"
 "END"
 
     IT DELIVERS WITH
     LJ = 0, UJ = 11, LL = 0, UL = 11, N = 50, Q = 4, A = .326, B = 7.83
     THE FOLLOWING RESULTS:
 
 
    K   DISCR[1]      DISCR[2]      RATECONV
 
  +45 +.4998463" -1 +.8903863" -2 +.2009943" +0
 
  +.1620445" +0    DOMINANT EIGENVALUE
 
   +7 +.3563865" -5 +.6714375" -6 +.1360086" +1
 
   +52             TOTAL NUMBER OF ITERATIONS
  +.3570259" +0    RATE OF CONVERGENCE WITH RESPECT TO
                   THE ZEROTH ITERAND OF RICHARDSON
1SECTION : 5.2.1.2.2.1.2      (OCTOBER 1974)                     PAGE 12
 
 
 
 SOURCE TEXT(S):
0"CODE"33170;
   "PROCEDURE" RICHARDSON(U,LJ,UJ,LL,UL,INAP,RESIDUAL,A,B,N,DISCR,K,
   RATECONV,DOMEIGVAL,OUT); "VALUE" LJ,UJ,LL,UL,A,B;
   "INTEGER" N,K,LJ,UJ,LL,UL; "REAL" A,B,RATECONV,DOMEIGVAL; "BOOLEAN"
   INAP; "ARRAY" U,DISCR; "PROCEDURE" RESIDUAL,OUT;
   "BEGIN" "INTEGER" J,L; "REAL" X,Y,Z,Y0,C,D,ALFA,OMEGA,OMEGA0,
     EIGMAX,EIGEUCL,EUCLRES,MAXRES,RCMAX,RCEUCL,MAXRES0,EUCLRES0;
     "ARRAY" V,RES[LJ:UJ,LL:UL];
     "PROCEDURE" CALPAR;
     "COMMENT" CALPAR CALCULATES THE PARAMETERS ALFA AND OMEGA FOR
     EACH ITERATION;
     "BEGIN" ALFA:= Z/(Z - ALFA);
       OMEGA:= 1/(X - OMEGA * Y)
     "END" CALPAR;
     "PROCEDURE" ITERATION;
     "COMMENT" FIRST THE ITERATION FORMULA IS CONSTRUCTED;
     "BEGIN" "REAL" AUXV,AUXU,AUXRES,EUCLUV,MAXUV;
       EUCLUV:= EUCLRES:= MAXUV:= MAXRES:= 0;
       "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
       "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO" RES[J,L]:= V[J,L];
       RESIDUAL(RES);
       "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
       "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO"
       "BEGIN" AUXV:= U[J,L]; AUXU:= V[J,L]; AUXRES:= RES[J,L];
         AUXV:= ALFA * AUXU - OMEGA * AUXRES + (1 - ALFA) * AUXV;
         V[J,L]:= AUXV; U[J,L]:= AUXU;
         "COMMENT" THE NORMS OF THE K-TH RESIDUAL AND THE DIFFERENCE
         BETWEEN THE (K+1)-TH AND K-TH ITERAND ARE CALCULATED;
         AUXU:= ABS(AUXU - AUXV); AUXRES:= ABS(AUXRES);
         MAXUV:= "IF" MAXUV < AUXU "THEN" AUXU "ELSE" MAXUV;
         MAXRES:= "IF" MAXRES < AUXRES "THEN" AUXRES "ELSE" MAXRES;
         EUCLUV:= EUCLUV + AUXU * AUXU;
         EUCLRES:= EUCLRES + AUXRES * AUXRES;
       "END";
       EUCLUV:= SQRT(EUCLUV); EUCLRES:= SQRT(EUCLRES);
       DISCR[1]:= EUCLRES; DISCR[2]:= MAXRES;
       "COMMENT" DOMEIGVAL IS EVALUATED;
       MAXUV:= MAXRES/MAXUV; EUCLUV:= EUCLRES/EUCLUV;
       EIGMAX:= MAXUV * (C - MAXUV)/(.25 * D - MAXUV);
       EIGEUCL:= EUCLUV * (C - EUCLUV)/(.25 * D - EUCLUV);
       DOMEIGVAL:= .5 * (EIGMAX + EIGEUCL);
       "COMMENT" FINALLY THE RATE OF CONVERGENCE IS CALCULATED;
       RCEUCL:= -LN(EUCLRES/EUCLRES0)/K;
       RCMAX:= -LN(MAXRES/MAXRES0)/K;
       RATECONV:= .5 * (RCEUCL + RCMAX)
     "END" ITERATION;                                          "COMMENT"
1SECTION : 5.2.1.2.2.1.2      (OCTOBER 1974)                     PAGE 13
                                                                 ;
 
 
     "COMMENT" THE CONSTANTS FOR STARTING CALPAR ARE CALCULATED;
     ALFA:= 2; OMEGA:= 4/(B + A); Y0:= (B + A)/(B - A);
     X:= .5 * (B + A); Y:= (B - A) * (B - A)/16; Z:= 4 * Y0 * Y0;
     "COMMENT" THE CONSTANTS NEEDED FOR DOMEIGVAL ARE CALCULATED;
     C:= A * B; C:= SQRT(C); D:= SQRT(A) + SQRT(B); D:= D * D;
     "COMMENT" THE INITIAL APPROXIMATION IS PUT INTO ARRAY U;
     "IF" ^INAP "THEN"
     "BEGIN" "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
       "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO" U[J,L]:= 1
     "END";
     "COMMENT" THE ZEROTH ITERATION IS NOW PERFORMED;
     K:= 0;
     "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
     "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO" RES[J,L]:= U[J,L];
     RESIDUAL(RES);
     OMEGA0:= 2/(B+A);
     "BEGIN" "REAL" AUXRES0;
       MAXRES0:= EUCLRES0:= 0;
       "FOR" J:= LJ "STEP" 1 "UNTIL" UJ "DO"
       "FOR" L:= LL "STEP" 1 "UNTIL" UL "DO"
       "BEGIN" AUXRES0:= RES[J,L];
         V[J,L]:= U[J,L] - OMEGA0 * AUXRES0;
         AUXRES0:= ABS(AUXRES0);
         MAXRES0:= "IF" MAXRES0 < AUXRES0 "THEN" AUXRES0 "ELSE" MAXRES0;
         EUCLRES0:= EUCLRES0 + AUXRES0 * AUXRES0
       "END";
     EUCLRES0:= SQRT(EUCLRES0)
     "END";
     DISCR[1]:= EUCLRES0; DISCR[2]:= MAXRES0;
     OUT(K);
     "IF" K >= N "THEN" "GOTO" FINALLY;
   NEXT STEP:
     K:= K + 1; CALPAR; ITERATION; OUT(K);
     "IF" K < N "THEN" "GOTO" NEXT STEP;
   FINALLY:
   "END" RICHARDSON
1SECTION : 5.2.1.2.2.1.2      (OCTOBER 1974)                     PAGE 14
 
 
                                                                  ;
         "EOP"
 "CODE"33171;
   "PROCEDURE" ELIMINATION(U,LJ,UJ,LL,UL,RESIDUAL,A,B,N,DISCR,K,
       RATECONV,DOMEIGVAL,OUT);
   "VALUE" LJ,UJ,LL,UL,A,B; "INTEGER" LJ,UJ,LL,UL,N,K;
   "REAL" A,B,RATECONV,DOMEIGVAL; "ARRAY" U,DISCR;
   "PROCEDURE" RESIDUAL,OUT;
   "BEGIN" "REAL" PI,AUXCOS,C,D;
     "REAL" "PROCEDURE" OPTPOL(X); "VALUE" X; "REAL" X;
     "BEGIN" "REAL" W,Y;
       W:= (B * COS(.5*PI/X) + DOMEIGVAL) / (B - DOMEIGVAL);
       "IF" W < -1 "THEN" W:= -1;
       "IF" ABS(W) <= 1 "THEN"
       "BEGIN" Y:= ARCCOS(W);
         OPTPOL:= 2 * SQRT(A/B) + TAN(X*Y) *
         (Y - B*PI*SIN(.5*PI/X)*.5 / (X * (B-DOMEIGVAL) *
         SQRT(ABS(1-W*W))))
       "END" "ELSE"
       "BEGIN" Y:= LN(W + SQRT(ABS(W*W-1)));
         OPTPOL:= 2 * SQRT(A/B) - TANH(X*Y) * (Y + B*PI*SIN(.5*PI/X)*
         .5/(X*(B-DOMEIGVAL)*SQRT(ABS(W*W-1))))
       "END"
     "END" OPTPOL;
     PI:= 3.1415 92653 58979;
     C:= 1;
     "IF" OPTPOL(C) < 0 "THEN"
    "BEGIN" D:= .5 * PI * SQRT(ABS(B/DOMEIGVAL));
     M: D:= D + D;
      "IF" ZEROIN(C,D,OPTPOL(C),C*"-3) "THEN" N:= ENTIER(C+.5)
       "ELSE" "GOTO" M;
     "END" "ELSE" N:= 1;
     AUXCOS:= COS(.5*PI/N);
     RICHARDSON(U,LJ,UJ,LL,UL,"TRUE",RESIDUAL,
     (2*DOMEIGVAL + B*(AUXCOS-1))/(AUXCOS+1),B,N,DISCR,K,RATECONV,
     DOMEIGVAL,OUT)
   "END" ELIMINATION;
         "EOP"
1SECTION : 5.2.1.3.1         (FEBRUARY 1979)                     PAGE 1
 
 
 
 AUTHOR : B. VAN DOMSELAAR.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 750601.
 
 
 BRIEF DESCRIPTION:
 
     PEIDE ESTIMATES UNKNOWN VARIABLES IN A SYSTEM OF
     FIRST ORDER DIFFERENTIAL EQUATIONS; THE UNKNOWN VARIABLES MAY
     APPEAR NONLINEAR BOTH IN THE DIFFERENTIAL EQUATIONS AND ITS INITIAL
     VALUES; A SET OF OBSERVED VALUES OF SOME COMPONENTS OF THE SOLUTION
     OF THE DIFFERENTIAL EQUATIONS MUST BE GIVEN;
 
 
 KEYWORDS:
 
     PARAMETER ESTIMATION,
     DIFFERENTIAL EQUATIONS,
     INITIAL VALUE PROBLEM,
     DATA FITTING.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THIS PROCEDURE IS:
     "PROCEDURE" PEIDE(N, M, NOBS, NBP, PAR, RV, BP, JTJINV, IN, OUT,
        DERIV, JAC DFDY, JACDFDP, CALL YSTART, DATA, MONITOR);
     "VALUE" N,M,NOBS; "INTEGER" N,M,NOBS,NBP;
     "ARRAY" PAR,RV,JTJINV,IN,OUT; "INTEGER" "ARRAY" BP;
     "PROCEDURE" CALL YSTART,DATA,MONITOR;
     "BOOLEAN" "PROCEDURE" DERIV,JAC DFDY,JAC DFDP;
     "CODE" 34444;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     N:        <ARITHMETIC EXPRESSION>;
               THE NUMBER OF DIFFERENTIAL EQUATIONS;
     M:        <ARITHMETIC EXPRESSION>;
               THE NUMBER OF UNKNOWN VARIABLES;
     NOBS:     <ARITHMETIC EXPRESSION>;
               THE NUMBER OF OBSERVATIONS; NOBS SHOULD SATISFY  NOBS>=M;
     NBP:      <VARIABLE>;
               ENTRY: THE NUMBER OF BREAK-POINTS; IF NO BREAK-POINTS ARE
                      USED THEN SET NBP=0;
               EXIT:  WITH NORMAL TERMINATION OF THE PROCESS NBP=0;
                      OTHERWISE, IF THE PROCESS HAS BEEN BROKEN OFF (SEE
                      OUT[1]), THE VALUE OF NBP IS THE NUMBER OF BREAK-
                      POINTS USED BEFORE THE PROCESS BROKE OFF;
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                      PAGE 2
 
 
 
     PAR:      <ARRAY IDENTIFIER>;
               "ARRAY" PAR[1 : M+NBP];
               ENTRY: PAR[1:M] SHOULD CONTAIN AN INITIAL APPROXIMATION
                      TO THE REQUIRED PARAMETER VECTOR;
               EXIT:  PAR[1:M] CONTAINS THE CALCULATED PARAMETER VECTOR;
                      IF OUT[1]>0 AND NBP>0 THEN PAR[M+1:M+NBP] CONTAINS
                      THE VALUES OF THE NEWLY INTRODUCED PARAMETERS
                      BEFORE THE PROCESS BROKE OFF;
     RV:       <ARRAY IDENTIFIER>;
               "ARRAY" RV[1 : NOBS+NBP];
               EXIT:  RV[1:NOBS] CONTAINS THE RESIDUAL VECTOR AT THE
                      CALCULATED MINIMUM; IF OUT[1]>0 AND NBP>0 THEN
                      RV[NOBS+1:NOBS+NBP] CONTAINS THE ADDITIONAL
                      CONTINUITY REQUIREMENTS AT THE BREAK-POINTS BEFORE
                      THE PROCESS BROKE OFF;
     BP:       <ARRAY IDENTIFIER>;
               "INTEGER" "ARRAY" BP[0 : NBP];
               ENTRY: BP[I], I=1,...,NBP, SHOULD CORRESPOND TO THE INDEX
                      OF THAT TIME OF OBSERVATION WHICH WILL BE USED AS
                      A BREAK-POINT (1<=BP[I]<=NOBS); THE BREAK-POINTS
                      HAVE TO BE ORDERED SUCH THAT BP[I]<=BP[J] IF I<=J;
               EXIT:  WITH NORMAL TERMINATION OF THE PROCESS BP[1:NBP]
                      CONTAINS NO INFORMATION; OTHERWISE, IF OUT[1]>0
                      AND NBP>0 THEN BP[I], I=1,...,NBP, CONTAINS THE
                      INDEX OF THAT TIME OF OBSERVATION WHICH WAS USED
                      AS A BREAK-POINT BEFORE THE PROCESS BROKE OFF;
     JTJINV:   <ARRAY IDENTIFIER>;
               "ARRAY" JTJINV[1 : M, 1 : M];
               EXIT:  THE INVERSE OF THE MATRIX  J' * J  WHERE J DENOTES
                      THE MATRIX OF PARTIAL DERIVATIVES DRV[I] / DPAR[K]
                      (I=1,...,NOBS ; K=1,...,M) AND J' DENOTES THE
                      TRANSPOSE OF J; THIS MATRIX CAN BE USED IF
                      ADDITIONAL INFORMATION ABOUT THE RESULT IS
                      REQUIRED; E.G. STATISTICAL DATA SUCH AS THE
                      COVARIANCE MATRIX, CORRELATION MATRIX AND
                      CONFIDENCE INTERVALS CAN EASILY BE CALCULATED FROM
                      JTJINV AND OUT[2];
     IN:       <ARRAY IDENTIFIER>;
               "ARRAY" IN[0 : 6];
               ENTRY:  IN THIS ARRAY THE USER SHOULD GIVE SOME DATA TO
                       CONTROL THE PROCESS;
               IN[0]:  THE MACHINE PRECISION;
                       FOR THE CYBER 73 A SUITABLE VALUE IS "-14;
               IN[1]:  THE RATIO: THE MINIMAL STEPLENGTH FOR THE
                       INTEGRATION OF THE DIFFERENTIAL EQUATIONS DIVIDED
                       BY THE DISTANCE BETWEEN TWO NEIGHBOURING
                       OBSERVATIONS; MOSTLY, A SUITABLE VALUE IS "-4;
               IN[2]:  THE RELATIVE LOCAL ERROR BOUND FOR THE
                       INTEGRATION PROCESS; THIS VALUE SHOULD SATISFY
                       IN[2]<=IN[3]; THIS PARAMETER CONTROLS THE
                       ACCURACY OF THE NUMERICAL INTEGRATION; MOSTLY,
                       A SUITABLE VALUE IS IN[3]/100;
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                      PAGE 3
 
 
 
               IN[3], IN[4]:
                       THE RELATIVE AND THE ABSOLUTE TOLERANCE FOR
                       THE DIFFERENCE BETWEEN THE EUCLIDEAN NORM OF THE
                       ULTIMATE AND PENULTIMATE RESIDUAL VECTOR
                       RESPECTIVELY;
                       THE PROCESS IS TERMINATED IF THE IMPROVEMENT OF
                       THE SUM OF SQUARES IS LESS THAN
                       IN[3] * (SUM OF SQUARES) + IN[4] * IN[4];
                       THESE TOLERANCES SHOULD BE CHOSEN IN ACCORDANCE
                       WITH THE RELATIVE, RESP. ABSOLUTE ERRORS IN THE
                       OBSERVATIONS;
                       NOTE THAT THE EUCLIDEAN NORM OF THE RESIDUAL
                       VECTOR IS DEFINED AS THE SQUARE ROOT OF THE SUM
                       OF SQUARES;
               IN[5]:  THE MAXIMUM NUMBER OF TIMES THAT THE INTEGRATION
                       OF THE DIFFERENTIAL EQUATIONS IS PERFORMED;
               IN[6]:  A STARTING VALUE USED FOR THE RELATION BETWEEN
                       THE GRADIENT AND THE GAUSS-NEWTON DIRECTION (SEE
                       [1]);  IF THE PROBLEM IS WELL CONDITIONED THEN A
                       SUITABLE VALUE FOR IN[6] WILL BE  0.01; IF THE
                       PROBLEM IS ILL CONDITIONED THEN IN[6] SHOULD BE
                       GREATER, BUT THE VALUE OF IN[6] SHOULD SATISFY:
                       IN[0] < IN[6] <= 1/IN[0];
     OUT:      <ARRAY IDENTIFIER>;
               "ARRAY" OUT[1 : 7];
               EXIT :  IN ARRAY  OUT  SOME BY-PRODUCTS ARE DELIVERED;
               OUT[1]: THIS VALUE GIVES INFORMATION ABOUT THE
                       TERMINATION OF THE PROCESS;
                       OUT[1]=0:  NORMAL TERMINATION;
                       IF OUT[1]>0 THEN THE PROCESS HAS BEEN BROKEN OFF
                       AND THIS MAY OCCUR BECAUSE OF THE FOLLOWING
                       REASONS:
                       OUT[1]=1:  THE NUMBER OF INTEGRATIONS PERFORMED
                                  EXCEEDED THE NUMBER GIVEN IN IN[5];
                       OUT[1]=2:  THE DIFFERENTIAL EQUATIONS ARE VERY
                                  NONLINEAR; DURING AN INTEGRATION THE
                                  VALUE OF IN[1] WAS DECREASED BY A
                                  FACTOR 10000 AND IT IS ADVISED TO
                                  DECREASE IN[1], ALTHOUGH THIS WILL
                                  INCREASE COMPUTING TIME;
                       OUT[1]=3:  A CALL OF DERIV DELIVERED THE VALUE
                                  FALSE;
                       OUT[1]=4:  A CALL OF  JAC DFDY  DELIVERED THE
                                  VALUE FALSE;
                       OUT[1]=5:  A CALL OF  JAC DFDP  DELIVERED  THE
                                  VALUE FALSE;
                       OUT[1]=6:  THE PRECISION ASKED FOR CAN NOT BE
                                  ATTAINED; THIS PRECISION IS POSSIBLY
                                  CHOSEN TOO HIGH, RELATIVE TO THE
                                  PRECISION IN WHICH THE RESIDUAL VECTOR
                                  IS CALCULATED (SEE IN[3]);
               OUT[2]: THE EUCLIDEAN NORM OF THE RESIDUAL VECTOR
                       CALCULATED WITH VALUES OF THE UNKNOWNS DELIVERED;
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                      PAGE 4
 
 
 
               OUT[3]: THE EUCLIDEAN NORM OF THE RESIDUAL VECTOR
                       CALCULATED WITH THE INITIAL VALUES OF THE
                       UNKNOWN VARIABLES;
               OUT[4]: THE NUMBER OF INTEGRATIONS PERFORMED, NEEDED TO
                       OBTAIN THE CALCULATED RESULT; IF OUT[4]=1 AND
                       OUT[1]>0 THEN THE MATRIX JTJINV CAN NOT BE USED;
               OUT[5]: THE MAXIMUM NUMBER OF TIMES THAT THE REQUESTED
                       LOCAL ERROR BOUND WAS EXCEEDED IN ONE
                       INTEGRATION; IF IT IS A LARGE NUMBER, IT MAY BE
                       BETTER TO DECREASE THE VALUE OF IN[1];
               OUT[6]: THE  IMPROVEMENT OF THE EUCLIDEAN NORM OF THE
                       RESIDUAL VECTOR IN THE LAST ITERATION STEP OF THE
                       PROCESS OF MARQUARDT;
               OUT[7]: THE CONDITION NUMBER OF  J' * J , I.E. THE RATIO
                       OF ITS LARGEST TO SMALLEST EIGENVALUES;
     DERIV:    <PROCEDURE IDENTIFIER>;
               THIS PROCEDURE DEFINES THE RIGHT HAND SIDE OF THE
               DIFFERENTIAL EQUATIONS;
               THE HEADING OF THIS PROCEDURE SHOULD BE:
               "BOOLEAN" "PROCEDURE" DERIV(PAR, Y, T, DF); "VALUE" T;
               "REAL" T; "ARRAY" PAR,Y,DF;
               ENTRY: PAR,Y,T;
                      PAR[1:M] CONTAINS THE CURRENT VALUES OF THE
                      UNKNOWNS AND SHOULD NOT BE ALTERED;
                      Y[1:N] CONTAINS THE SOLUTIONS OF THE DIFFERENTIAL
                      EQUATIONS AT TIME T AND SHOULD NOT BE ALTERED;
               EXIT:  "ARRAY" DF[1 : N];
                      AN ARRAY ELEMENT DF[I] SHOULD CONTAIN THE RIGHT
                      HAND SIDE OF THE I-TH DIFFERENTIAL EQUATION;
               AFTER A SUCCESSFUL CALL OF DERIV, THE BOOLEAN PROCEDURE
               SHOULD DELIVER THE VALUE TRUE;
               HOWEVER, IF DERIV DELIVERS THE VALUE FALSE, THEN THE
               PROCESS IS TERMINATED (SEE OUT[1]);
               HENCE, PROPER PROGRAMMING OF DERIV MAKES IT POSSIBLE TO
               AVOID CALCULATION OF THE RIGHT HAND SIDE WITH VALUES OF
               THE UNKNOWN VARIABLES WHICH CAUSE OVERFLOW IN THE
               COMPUTATION;
     JAC DFDY: <PROCEDURE IDENTIFIER>;
               THE HEADING OF THIS PROCEDURE SHOULD BE:
               "BOOLEAN" "PROCEDURE" JAC DFDY(PAR, Y, T, FY); "VALUE" T;
               "REAL" T; "ARRAY" PAR,Y,FY;
               ENTRY: PAR,Y,T;
                      SEE DERIV;
               EXIT:  "ARRAY" FY[1 : N,1 : N];
                      AN ARRAY ELEMENT FY[I,J] SHOULD CONTAIN THE
                      PARTIAL DERIVATIVE OF THE RIGHT HAND SIDE OF THE
                      I-TH DIFFERENTIAL EQUATION WITH RESPECT TO Y[J],
                      I.E. DF[I]/DY[J];
               THE BOOLEAN VALUE SHOULD BE ASSIGNED TO THIS PROCEDURE
               IN THE SAME WAY AS IT IS DONE FOR THE VALUE OF DERIV;
     JAC DFDP: <PROCEDURE IDENTIFIER>;
               THE HEADING OF THIS PROCEDURE SHOULD BE:
               "BOOLEAN" "PROCEDURE" JAC DFDP(PAR, Y, T, FP); "VALUE" T;
               "REAL" T; "ARRAY" PAR,Y,FP;
1SECTION : 5.2.1.3.1         (FEBRUARY 1979)                     PAGE 5
 
 
 
               ENTRY: PAR,Y,T;
                      SEE DERIV;
               EXIT:  "ARRAY" FP[1 : N,1 : M];
                      AN ARRAY ELEMENT FP[I,J] SHOULD CONTAIN THE
                      PARTIAL DERIVATIVE OF THE RIGHT HAND SIDE OF THE
                      I-TH DIFFERENTIAL EQUATION WITH RESPECT TO PAR[J],
                      I.E. DF[I]/DPAR[J];
               THE BOOLEAN VALUE SHOULD BE ASSIGNED TO THIS PROCEDURE
               IN THE SAME WAY AS IT IS DONE FOR THE VALUE OF DERIV;
     CALL YSTART: <PROCEDURE IDENTIFIER>;
               THIS PROCEDURE DEFINES THE INITIAL VALUES OF THE INITIAL
               VALUE PROBLEM;
               THE HEADING OF THIS PROCEDURE SHOULD BE:
               "BOOLEAN" "PROCEDURE" CALL YSTART(PAR, Y, YMAX);
               "ARRAY" PAR,Y,YMAX;
               ENTRY: PAR;
                      PAR[1:M] CONTAINS THE CURRENT VALUES OF THE
                      UNKNOWN VARIABLES AND SHOULD NOT BE ALTERED;
               EXIT:  Y,YMAX;
                      Y[1:N] SHOULD CONTAIN THE INITIAL VALUES OF THE
                      CORRESPONDING DIFFERENTIAL EQUATIONS;
                      THE INITIAL VALUES MAY BE FUNCTIONS OF THE UNKNOWN
                      VARIABLES PAR; IN THAT CASE, THE INITIAL VALUES OF
                      DY/DPAR ALSO HAVE TO BE SUPPLIED; NOTE THAT
                      DY[I]/DPAR[J] CORRESPONDS WITH  Y[5*N+J*N+I]
                      (I=1,...,N , J=1,...,M);
                      YMAX[I], I=1,...,N, SHOULD CONTAIN A ROUGH
                      ESTIMATE TO THE MAXIMAL ABSOLUTE VALUE OF Y[I]
                      OVER THE INTEGRATION INTERVAL;
     DATA:     <PROCEDURE IDENTIFIER>;
               THIS PROCEDURE TAKES THE DATA TO FIT INTO THE PROCEDURE
               PEIDE;
               THE HEADING OF THIS PROCEDURE SHOULD BE:
               "PROCEDURE" DATA(NOBS, TOBS, OBS, COBS); "VALUE" NOBS;
               "INTEGER" NOBS; "ARRAY" TOBS,OBS; "INTEGER" "ARRAY" COBS;
               ENTRY: NOBS;
                      NOBS HAS THE SAME MEANING AS IN PEIDE;
               EXIT:  "ARRAY" TOBS[0 : NOBS];
                      THE ARRAY ELEMENT TOBS[0] SHOULD CONTAIN THE TIME,
                      CORRESPONDING TO THE INITIAL VALUES OF Y GIVEN IN
                      THE PROCEDURE  CALL YSTART; AN ARRAY ELEMENT
                      TOBS[I], 1<=I<=NOBS, SHOULD CONTAIN THE I-TH TIME
                      OF OBSERVATION; THE OBSERVATIONS HAVE TO BE
                      ORDERED SUCH THAT TOBS[I]<=TOBS[J] IF I<=J;
                      "INTEGER" "ARRAY" COBS[1:NOBS];
                      AN ARRAY ELEMENT COBS[I] SHOULD CONTAIN THE
                      COMPONENT OF Y OBSERVED AT TIME TOBS[I]; NOTE THAT
                      1<=COBS[I]<=N;
                      "ARRAY" OBS[1:NOBS];
                      AN ARRAY ELEMENT OBS[I] SHOULD CONTAIN THE
                      OBSERVED VALUE OF THE COMPONENT COBS[I] OF Y AT
                      THE TIME TOBS[I];
1SECTION : 5.2.1.3.1         (FEBRUARY 1979)                     PAGE 6
 
 
 
     MONITOR:  <PROCEDURE IDENTIFIER>;
               THIS PROCEDURE CAN BE USED TO OBTAIN INFORMATION ABOUT
               THE COURSE OF THE ITERATION PROCESS; IF NO INTERMEDIATE
               RESULTS ARE DESIRED, A DUMMY PROCEDURE SATISFIES;
               THE HEADING OF THIS PROCEDURE SHOULD BE:
               "PROCEDURE" MONITOR(POST,NCOL,NROW,PAR,RV,WEIGHT,NIS);
               "VALUE" POST,NCOL,NROW,WEIGHT,NIS;
               "INTEGER" POST,NCOL,NROW,WEIGHT,NIS; "ARRAY" PAR,RV;
               INSIDE PEIDE, THE PROCEDURE MONITOR IS CALLED AT TWO
               DIFFERENT PLACES AND THIS IS DENOTED BY THE VALUE OF
               POST:
               POST=1:  MONITOR IS CALLED AFTER AN INTEGRATION OF THE
                        DIFFERENTIAL EQUATIONS; AT THIS PLACE ARE
                        AVAILABLE: THE CURRENT VALUES OF THE UNKNOWN
                        VARIABLES PAR[1:NCOL], WHERE NCOL=M+NBP, THE
                        CALCULATED RESIDUAL VECTOR RV[1:NROW], WHERE
                        NROW=NOBS+NBP, AND THE VALUE OF NIS, WHICH IS
                        THE NUMBER OF INTEGRATION STEPS PERFORMED DURING
                        THE SOLUTION OF THE LAST INITIAL VALUE PROBLEM;
               POST=2:  MONITOR IS CALLED BEFORE A MINIMIZATION OF THE
                        EUCLIDEAN NORM OF THE RESIDUAL VECTOR WITH THE
                        PROCEDURE MARQUARDT (SEE SECTION 5.1.3.1.3) IS
                        STARTED; AVAILABLE ARE THE CURRENT VALUES OF
                        PAR[1:NCOL] AND  THE VALUE OF THE WEIGHT, WITH
                        WHICH THE CONTINUITY REQUIREMENTS AT THE BREAK-
                        POINTS ARE ADDED TO THE ORIGINAL LEAST SQUARES
                        PROBLEM.
 
 
 DATA AND RESULTS: SEE REF[1].
 
 
 PROCEDURES USED:
 
     INIVEC = CP31010,
     INIMAT = CP31011,
     MULVEC = CP31020,
     MULROW = CP31021,
     DUPVEC = CP31030,
     DUPMAT = CP31035,
     VECVEC = CP34010,
     MATVEC = CP34011,
     ELMVEC = CP34020,
     SOL = CP34051,
     DEC = CP34300,
     MARQUARDT = CP34440.
 
1SECTION : 5.2.1.3.1          (FEBRUARY 1979)                     PAGE 7
 
 
 
 REQUIRED CENTRAL MEMORY :
       IN THE BODY OF PEIDE (3 + NBP) * NOBS +
       N * (13 + N + 7 * M + 7 * NBP) ARRAY
       ELEMENTS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
      PEIDE ESTIMATES UNKNOWN VARIABLES IN THE SYSTEM OF DIFFERENTIAL
      EQUATIONS  DY/DT (T, PAR) = F (T, Y, PAR), BY USING A SET OF
      OBSERVED VALUES OF Y; THE UNKNOWN VARIABLES  PAR  ARE OBTAINED IN
      THE LEAST SQUARES SENSE; AN ELEMENT OF THE RESIDUAL VECTOR IS
      DEFINED BY THE CALCULATED VALUE OF Y MINUS ITS OBSERVED VALUE;
      THE EUCLIDEAN NORM OF THE RESIDUAL VECTOR IS MINIMIZED BY THE
      ITERATION PROCESS OF MARQUARDT; THE DIFFERENTIAL EQUATIONS ARE
      SOLVED BY THE INTEGRATION PROCESS OF GEAR; A MULTIPLE SHOOTING
      TECHNIQUE HAS BEEN IMPLEMENTED TO IMPROVE BAD STARTING VALUES OF
      THE UNKNOWNS; IF THIS TECHNIQUE IS USED, ONE HAS TO GIVE SOME
      BREAK-POINTS, I.E. TIMES OF OBSERVATIONS WHERE A NEW INITIAL
      VALUE PROBLEM SHOULD BE STARTED; THE NEW INITIAL VALUES OF Y
      BECOME EXTRA UNKNOWN VARIABLES AND THE CONTINUITY REQUIREMENTS
      AT THE BREAK-POINTS ARE ADDED WITH SOME WEIGHTING FACTOR TO THE
      LEAST SQUARES PROBLEM; FOR DETAILS SEE REF[1].
 
 
 REFERENCES:
      [1]: B. VAN DOMSELAAR,
           NONLINEAR PARAMETER ESTIMATION IN INITIAL VALUE PROBLEMS,
           MATH. CENTRE, AMSTERDAM (TO APPEAR).
 
 
 EXAMPLE OF USE:
 
      THE PARAMETERS PAR[1:3] IN THE DIFFERENTIAL EQUATIONS
         DY[1]/DT = - (1 - Y[2]) * Y[1] + EXP(PAR[2]) * Y[2],
         DY[2]/DT = EXP(PAR[1]) * ((1 - Y[2]) * Y[1] - (EXP(PAR[2])+
                    +EXP(PAR[3])) * Y[2]),
      WITH 23 OBSERVATIONS OF Y[2], MAY BE OBTAINED BY THE FOLLOWING
      PROGRAM, THAT CONSISTS OF
           1: A CODE PROCEDURE WHICH TAKES CARE OF THE OUTPUT OF THE
           EXAMPLE PROGRAM. IT ALSO INTERPRETS THE NUMERICAL DATA
           THAT CAN BE USED TO OBTAIN STATISTICAL RESULTS;
           2: THE USERS PROGRAM IN WHICH THE PROBLEM EXAMPLE IS DEFINED.
 
 
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                      PAGE 8
 
 
 
 "CODE" 34445;
 "PROCEDURE" COMMUNICATION(POST,FA,N,M,NOBS,NBP,PAR,RES,BP,JTJINV,
                           IN,OUT,WEIGHT,NIS);
 "VALUE" POST,FA,N,M,NOBS,NBP,WEIGHT,NIS;
 "INTEGER" POST,N,M,NOBS,NBP,WEIGHT,NIS; "REAL" FA;
 "ARRAY" PAR,RES,JTJINV,IN,OUT; "INTEGER""ARRAY" BP;
 "BEGIN" "INTEGER" I,J; "REAL" C; "ARRAY" CONF[1:M];
  "IF" POST=5 "THEN"
  "BEGIN" OUTPUT(61,"("*,/,10B,"("THE FIRST RESIDUAL VECTOR")",//,16B,
    "("I")",4B,"("RES[I]")",/")");
    "FOR" I:=1 "STEP" 1 "UNTIL" NOBS "DO"
    OUTPUT(61,"("15B,ZD,2B,+.4D"+ZD,/")",I,RES[I]);
  "END" "ELSE" "IF" POST=3 "THEN"
  "BEGIN" OUTPUT(61,"("*,/,
    "("THE EUCLIDEAN NORM OF THE RESIDUAL VECTOR:")",
    .7D"+ZD,2/,5B,"("CALCULATED PARAMETERS")",/")",
    SQRT(VECVEC(1,NOBS,0,RES,RES)));
    "FOR" I:=1 "STEP" 1 "UNTIL" M "DO"
    OUTPUT(61,"("9B,+.7D"+ZD,/")",PAR[I]);
    OUTPUT(61,"("/,
    "("NUMBER OF INTEGRATION STEPS PERFORMED: ")",ZZD,//")",NIS);
  "END" "ELSE" "IF" POST=4 "THEN"
  "BEGIN" "IF" NBP=0 "THEN" OUTPUT(61,"("*,//,5B,
    "("THE MINIMIZATION IS STARTED WITHOUT BREAK-POINTS")"")") "ELSE"
    "BEGIN" OUTPUT(61,"("*,5/,20B,
      "("THE MINIMIZATION IS STARTED WITH  W E I G H T =")",ZD,
      3/")",WEIGHT);
      OUTPUT(61,"("/,5B,
      "("THE EXTRA PARAMETERS ARE THE OBSERVATIONS:")"")");
      "FOR" I:=1 "STEP" 1 "UNTIL" NBP "DO"
      OUTPUT(61,"("8B,ZD,2B")",BP[I]);
    "END";
    OUTPUT(61,"("6/,10B,
    "("STARTING VALUES OF THE PARAMETERS")",/")");
    "FOR" I:=1 "STEP" 1 "UNTIL" M "DO"
    OUTPUT(61,"("20B,+.7D"+ZD,/")",PAR[I]);
    OUTPUT(61,"("//,
    "("REL. TOLERANCE FOR THE EUCL. NORM OF THE RES. VECTOR:")"
    ,B,.7D"+ZD,/,
    "("ABS. TOLERANCE FOR THE EUCL. NORM OF THE RES. VECTOR:")"
    ,B,.7D"+ZD,/,"("RELATIVE STARTING VALUE OF LAMBDA")",19B,
    "(":")",B,.7D"+ZD")",IN[3],IN[4],IN[6])
  "END" "ELSE" "IF" POST=1 "THEN"
  "BEGIN"
  OUTPUT(61,"("10B,"("STARTING VALUES OF THE PARAMETERS")",/")");
  "FOR" I:=1 "STEP" 1 "UNTIL" M "DO"
  OUTPUT(61,"("20B,+.7D"+ZD,/")",PAR[I]);
                                                               "COMMENT"
1SECTION : 5.2.1.3.1          (OCTOBER 1975)                      PAGE 9
                                                                  ;
 
 
  OUTPUT(61,"("2/,"("NUMBER OF EQUATIONS")",3B,"(":")",ZD,/,
  "("NUMBER OF OBSERVATIONS:")",ZD,2/,
  "("MACHINE PRECISION")",30B,"(":")",+.D"+ZD,/,
  "("RELATIVE LOCAL ERROR BOUND FOR INTEGRATION")",5B,"(":")",+.D"+ZD,/,
  "("RELATIVE TOLERANCE FOR RESIDUE")",17B,"(":")",+.2D"+ZD,/,
  "("ABSOLUTE TOLERANCE FOR RESIDUE")",17B,"(":")",+.2D"+ZD,/,
  "("MAXIMUM NUMBER OF INTEGRATIONS TO PERFORM")",6B,"(":")",ZZD,/,
  "("RELATIVE STARTING VALUE OF LAMBDA")",14B,"(":")",+.2D"+ZD,/,
  "("RELATIVE MINIMAL STEPLENGTH")",20B,"(":")",+.2D"+ZD,/")",
  N,NOBS,IN[0],IN[2],IN[3],IN[4],IN[5],IN[6],IN[1]);
  "IF" NBP=0 "THEN" OUTPUT(61,"("//,
  "("THERE ARE NO BREAK-POINTS")"")") "ELSE"
  "BEGIN" OUTPUT(61,"("//,
    "("BREAK-POINTS ARE THE OBSERVATIONS :")"")");
    "FOR" I:=1 "STEP" 1 "UNTIL" NBP "DO"
    OUTPUT(61,"("ZZD,B")",BP[I])
  "END";
  OUTPUT(61,"("//,
  "("THE ALPHA-POINT OF THE F-DISTIBUTION :")",
  ZD.DD")",FA);
  "END" "ELSE" "IF" POST=2 "THEN"
  "BEGIN" OUTPUT(61,"("*")"); "IF" OUT[1]=0 "THEN" OUTPUT(61,"("2/,
  "("NORMAL TERMINATION OF THE PROCESS")"")")
  "ELSE" "IF" OUT[1]=1 "THEN" OUTPUT(61,"("2/,
  "("NUMBER OF INTEGRATIONS ALLOWED WAS EXCEEDED")"")")
  "ELSE" "IF" OUT[1]=2 "THEN" OUTPUT(61,"("2/,
  "("MINIMAL STEPLENGTH WAS DECREASED FOUR TIMES")"")")
  "ELSE" "IF" OUT[1]=3 "THEN" OUTPUT(61,"("2/,
  "("A CALL OF DERIV DELIVERED FALSE")"")")
  "ELSE" "IF" OUT[1]=4 "THEN" OUTPUT(61,"("2/,
  "("A CALL OF  JAC DFDY  DELIVERED FALSE ")"")")
  "ELSE" "IF" OUT[1]=5 "THEN" OUTPUT(61,"("2/,
  "("A CALL OF  JAC DFDP  DELIVERED FALSE ")"")")
  "ELSE" "IF" OUT[1]=6 "THEN" OUTPUT(61,"("2/,
  "("PRECISION ASKED FOR MAY NOT BE ATTAINED")"")");
  "IF" NBP=0 "THEN" OUTPUT(61,"("2/,
  "("LAST INTEGRATION WAS PERFORMED WITHOUT BREAK-POINTS")"")") "ELSE"
  "BEGIN" OUTPUT(61,"("2/,
    "("THE PROCESS STOPPED WITH BREAK-POINTS: ")"")");
    "FOR" I:=1 "STEP" 1 "UNTIL" NBP "DO"
    OUTPUT(61,"("ZZD,B")",BP[I])
  "END";
  OUTPUT(61,"("4/,
  "("EUCL. NORM OF THE LAST RESIDUAL VECTOR :")",.7D"+ZD,/,
  "("EUCL. NORM OF THE FIRST RESIDUAL VECTOR:")",.7D"+ZD,/,
  "("NUMBER OF INTEGRATIONS PERFORMED")",7B,"(":")",ZZD,/,
  "("LAST IMPROVEMENT OF THE EUCLIDEAN NORM :")",.7D"+ZD,/,
  "("CONDITON NUMBER OF  J'*J")",15B,"(":")",.7D"+ZD,/,
  "("LOCAL ERROR BOUND WAS EXCEEDED (MAXIM.):")",ZZD,7/")",
  OUT[2],OUT[3],OUT[4],OUT[6],OUT[7],OUT[5]);
 
                                                               "COMMENT"
1SECTION : 5.2.1.3.1          (OCTOBER 1975)                     PAGE 10
                                                                 ;
 
 
  "COMMENT" STATISTICS FOR THE PARAMETERS;
  OUTPUT(61,"("//,B,"("PARAMETERS")",12B,"("CONFIDENCE INTERVAL")",
  /")");
  "FOR" I:=1 "STEP" 1 "UNTIL" M "DO"
  "BEGIN" CONF[I]:=SQRT(M*FA*JTJINV[I,I]/(NOBS-M))*OUT[2];
     OUTPUT(61,"("+.7D"+ZD,12B,+.7D"+ZD,/")",PAR[I],CONF[I]);
  "END";
  C:="IF" NOBS=M "THEN" 0 "ELSE" OUT[2]*OUT[2]/(NOBS-M);
  OUTPUT(61,"("5/,"("CORRELATION MATRIX")",11B,"("COVARIANCE MATRIX")",
  /")");
  "FOR" I:=1 "STEP" 1 "UNTIL" M "DO"
  "BEGIN" "FOR" J:=1 "STEP" 1 "UNTIL" M "DO"
     "BEGIN" "IF" I=J "THEN" OUTPUT(61,"("29B")");
        "IF" I>J "THEN" OUTPUT(61,"("+.7D"+ZD,B")",
        JTJINV[I,J]/SQRT(JTJINV[I,I]*JTJINV[J,J]))
        "ELSE" OUTPUT(61,"("+.7D"+ZD,B")",JTJINV[I,J]*C)
     "END"; OUTPUT(61,"("/")");
  "END"; OUTPUT(61,"("*")");
 
  OUTPUT(61,"("3/,10B,"("THE LAST RESIDUAL VECTOR")",//,15B,
  "("I")",4B,"("RES[I]")",/")");
  "FOR" I:=1 "STEP" 1 "UNTIL" NOBS "DO"
  OUTPUT(61,"("14B,ZD,2B,+.4D"+ZD,/")",I,RES[I])
  "END"
 "END" COMMUNICATION;
     "EOP"
 
 
 
 
 THE USER PROGRAM READS:
 
 
 "BEGIN" "INTEGER" I,M,N,NOBS,NBP; "REAL" TIME,FA;
  "ARRAY" PAR[1:6],RES[1:26],JTJINV[1:3,1:3],IN[0:6],OUT[1:7];
  "INTEGER" "ARRAY" BP[0:3];
 
  "PROCEDURE" COMMUNICATION(POST,FA,N,M,NOBS,NBP,PAR,RES,BP,JTJINV,
                            IN,OUT,WEIGHT,NIS);
  "VALUE" POST,FA,N,M,NOBS,NBP,WEIGHT,NIS;
  "INTEGER" POST,N,M,NOBS,NBP,WEIGHT,NIS; "REAL" FA;
  "ARRAY" PAR,RES,JTJINV,IN,OUT; "INTEGER""ARRAY" BP;
  "CODE" 34445;
 
  "BOOLEAN" "PROCEDURE" JAC DFDP(PAR,Y,X,FP);
     "REAL" X; "ARRAY" PAR,Y,FP;
     "BEGIN" "REAL" Y2; Y2:=Y[2];
        FP[1,1]:=FP[1,3]:=0;
        FP[1,2]:=Y2*EXP(PAR[2]);
        FP[2,1]:=EXP(PAR[1])*(Y[1]*(1-Y2)-(EXP(PAR[2])+EXP(PAR[3]))*Y2);
        FP[2,2]:=-EXP(PAR[1]+PAR[2])*Y2;
        FP[2,3]:=-EXP(PAR[1]+PAR[3])*Y2;
        JAC DFDP:="TRUE"
     "END" JAC DFDP
1SECTION : 5.2.1.3.1          (OCTOBER 1975)                     PAGE 11
 
                                                                 ;
 
 
  "PROCEDURE" DATA(NOBS,TOBS,OBS,COBS);
     "VALUE" NOBS; "INTEGER" NOBS;
     "ARRAY" TOBS,OBS; "INTEGER" "ARRAY" COBS;
     "BEGIN" "INTEGER" I;
        TOBS[0]:=0;
        OUTPUT(61,"("*,4/,4B,"("THE OBSERVATIONS WERE:")",
        //,B,"("I")",3B,"("TOBS[I]")",3B,"("COBS[I]")",3B,
        "("OBS[I]")",/")");
        "FOR" I:=1 "STEP" 1 "UNTIL" NOBS "DO"
        "BEGIN" INREAL(70, TOBS[I]); ININTEGER(70, COBS[I]);
           INREAL(70, OBS[I]);
           OUTPUT(61,"("ZD,3B,ZD.4D,6B,D,6B,.4D,/")",I,TOBS[I],COBS[I],
           OBS[I])
        "END"
     "END" DATA;
 
  "PROCEDURE" CALL YSTART(PAR,Y,YMAX);
     "ARRAY" PAR,Y,YMAX;
     "BEGIN" Y[1]:=YMAX[1]:=YMAX[2]:=1;
        Y[2]:=0
     "END" CALL YSTART;
 
  "BOOLEAN" "PROCEDURE" DERIV(PAR,Y,X,DF);
     "REAL" X; "ARRAY" PAR,Y,DF;
     "BEGIN" "REAL" Y2; Y2:=Y[2];
        DF[1]:=-(1-Y2)*Y[1]+EXP(PAR[2])*Y2;
        DF[2]:=EXP(PAR[1])*((1-Y2)*Y[1]-(EXP(PAR[2])+EXP(PAR[3]))*Y2);
        DERIV:="TRUE"
     "END" DERIV;
 
  "BOOLEAN" "PROCEDURE" JAC DFDY(PAR,Y,X,FY);
     "REAL" X; "ARRAY" PAR,Y,FY;
     "BEGIN" FY[1,1]:=-1+Y[2];
        FY[1,2]:=EXP(PAR[2])+Y[1];
        FY[2,1]:=EXP(PAR[1])*(1-Y[2]);
        FY[2,2]:=-EXP(PAR[1])*(EXP(PAR[2])+EXP(PAR[3])+Y[1]);
        JAC DFDY:="TRUE"
     "END" JAC DFDY;
 
  "PROCEDURE" MONITOR(POST,NCOL,NROW,PAR,RES,WEIGHT,NIS);
   "VALUE" POST,NCOL,NROW,WEIGHT,NIS;
   "INTEGER" POST,NCOL,NROW,WEIGHT,NIS; "ARRAY" PAR,RES;;
 
  OUTPUT(61,"("2/,30B,"("E S C E P - PROBLEM")",3/")");
  M:= 3; N:=2; NOBS:=23; NBP:=3;
  PAR[1]:=LN(1600); PAR[2]:=LN(.8); PAR[3]:=LN(1.2); IN[0]:="-14;
  IN[3]:="-4; IN[4]:="-4; IN[5]:=50; IN[6]:="-2;
  IN[1]:="-4; IN[2]:="-5;
  BP[1]:=17; BP[2]:=19; BP[3]:=21;
                                                               "COMMENT"
1SECTION : 5.2.1.3.1          (OCTOBER 1975)                     PAGE 12
                                                                 ;
 
 
  FA:=4.94;
  "COMMENT"  FA  DENOTES THE ALPHA-POINT OF THE FISHER-DISTRIBUTION;
 
  COMMUNICATION(1,FA,N,M,NOBS,NBP,PAR,RES,BP,JTJINV,IN,OUT,0,0);
  TIME:=CLOCK;
 
  PEIDE(N,M,NOBS,NBP,PAR,RES,BP,JTJINV,IN,OUT,DERIV,JAC DFDY,JAC DFDP,
  CALL YSTART,DATA,MONITOR);
 
  TIME:=CLOCK-TIME;
  COMMUNICATION(2,FA,N,M,NOBS,NBP,PAR,RES,BP,JTJINV,IN,OUT,0,0);
  OUTPUT(61,"("3/,5B,
  "("THE CALCULATION IN PEIDE CONSUMED")",B,ZZD.DD,2B,
  "("SECONDS")",*")",TIME)
 "END"
 
  THIS PROGRAM DELIVERS:
 
 
                               E S C E P - PROBLEM
 
 
           STARTING VALUES OF THE PARAMETERS
                     +.7377759" +1
                     -.2231436" +0
                     +.1823216" +0
 
 
 NUMBER OF EQUATIONS   : 2
 NUMBER OF OBSERVATIONS:23
 
 MACHINE PRECISION                              :+.1"-13
 RELATIVE LOCAL ERROR BOUND FOR INTEGRATION     :+.1" -4
 RELATIVE TOLERANCE FOR RESIDUE                 :+.10" -3
 ABSOLUTE TOLERANCE FOR RESIDUE                 :+.10" -3
 MAXIMUM NUMBER OF INTEGRATIONS TO PERFORM      : 50
 RELATIVE STARTING VALUE OF LAMBDA              :+.10" -1
 RELATIVE MINIMAL STEPLENGTH                    :+.10" -3
 
 
 BREAK-POINTS ARE THE OBSERVATIONS : 17  19  21
 
 THE ALPHA-POINT OF THE F-DISTIBUTION : 4.94
 
 
 
 
     THE OBSERVATIONS WERE:
1SECTION : 5.2.1.3.1          (OCTOBER 1975)                     PAGE 13
 
 
 
 
  I   TOBS[I]   COBS[I]   OBS[I]
  1    0.0002      2      .1648
  2    0.0004      2      .2753
  3    0.0006      2      .3493
  4    0.0008      2      .3990
  5    0.0010      2      .4322
  6    0.0012      2      .4545
  7    0.0014      2      .4695
  8    0.0016      2      .4795
  9    0.0018      2      .4862
 10    0.0020      2      .4907
 11    0.0200      2      .4999
 12    0.0400      2      .4998
 13    0.0600      2      .4998
 14    0.0800      2      .4998
 15    0.1000      2      .4998
 16    1.0000      2      .4986
 17    2.0000      2      .4973
 18    5.0000      2      .4936
 19   10.0000      2      .4872
 20   15.0000      2      .4808
 21   20.0000      2      .4743
 22   25.0000      2      .4677
 23   30.0000      2      .4610
 
 
 
 
 NORMAL TERMINATION OF THE PROCESS
 
 LAST INTEGRATION WAS PERFORMED WITHOUT BREAK-POINTS
 
 
 
 EUCL. NORM OF THE LAST RESIDUAL VECTOR :.1430776" -3
 EUCL. NORM OF THE FIRST RESIDUAL VECTOR:.1331071" +1
 NUMBER OF INTEGRATIONS PERFORMED       : 12
 LAST IMPROVEMENT OF THE EUCLIDEAN NORM :.2223694" -4
 CONDITON NUMBER OF  J'*J               :.2582882" +3
 LOCAL ERROR BOUND WAS EXCEEDED (MAXIM.): 37
 
 
 
 
 
 
 
1SECTION : 5.2.1.3.1          (OCTOBER 1975)                     PAGE 14
 
 
 
  PARAMETERS            CONFIDENCE INTERVAL
 +.6907670" +1            +.3209313" -3
 -.1003941" -1            +.1687774" -3
 -.4605292" +1            +.1942501" -2
 
 
 
 
 
 CORRELATION MATRIX           COVARIANCE MATRIX
                              +.6949857" -8 +.1407628" -8 -.9129848" -8
 +.3851320" +0                              +.1922119" -8 -.1414245" -7
 -.2170393" +0 -.6392889" +0                              +.2546094" -6
 
 
 
           THE LAST RESIDUAL VECTOR
 
                I    RES[I]
                1  +.1748" -5
                2  -.2905" -4
                3  +.2814" -4
                4  -.3879" -4
                5  +.3069" -4
                6  +.3101" -4
                7  -.2019" -4
                8  -.3887" -5
                9  +.1052" -4
               10  +.1391" -4
               11  -.5109" -4
               12  +.2384" -4
               13  -.1156" -5
               14  -.2616" -4
               15  -.5116" -4
               16  +.2244" -4
               17  +.6794" -4
               18  -.1418" -4
               19  +.2087" -4
               20  -.1980" -4
               21  -.3476" -4
               22  -.2245" -4
               23  +.1886" -4
 
 
 
      THE CALCULATION IN PEIDE CONSUMED 108.57  SECONDS
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 15
 
 
 
 SOURCE TEXT(S):
0"CODE" 34444;
 "PROCEDURE" PEIDE(N,M,NOBS,NBP,PAR,RES,BP,JTJINV,IN,OUT,DERIV,JAC DFDY,
    JAC DFDP, CALL YSTART,DATA,MONITOR);
    "VALUE" N,M,NOBS; "INTEGER" N,M,NOBS,NBP;
    "ARRAY" PAR,RES,JTJINV,IN,OUT;
    "INTEGER" "ARRAY" BP;
    "PROCEDURE"  CALL YSTART,DATA,MONITOR;
    "BOOLEAN" "PROCEDURE" DERIV,JAC DFDY,JACDFDP;
    "BEGIN" "INTEGER" I,J,EXTRA,WEIGHT,NCOL,NROW,AWAY,NPAR,II,JJ,MAX,
       NFE,NIS;
       "REAL" EPS,EPS1,XEND,C,X,T,HMIN,HMAX,RES1,IN3,IN4,FAC3,FAC4;
       "ARRAY" AUX[1:3],OBS[1:NOBS],SAVE[-38:6*N],TOBS[0:NOBS],
       YP[1:NBP+NOBS,1:NBP+M],YMAX[1:N],Y[1:6*N*(NBP+M+1)],FY[1:N,1:N],
       FP[1:N,1:M+NBP];
       "INTEGER" "ARRAY" COBS[1:NOBS];
       "BOOLEAN" FIRST,SEC,CLEAN;
 
       "REAL" "PROCEDURE" INTERPOL(STARTINDEX,JUMP,K,TOBSDIF);
          "VALUE" STARTINDEX,JUMP,K,TOBSDIF;
          "INTEGER" STARTINDEX,JUMP,K; "REAL" TOBSDIF;
          "BEGIN" "INTEGER" I; "REAL" S,R; S:=Y[STARTINDEX]; R:=TOBSDIF;
             "FOR" I:=1 "STEP" 1 "UNTIL" K "DO"
             "BEGIN" STARTINDEX:=STARTINDEX+JUMP;
                S:=S+Y[STARTINDEX]*R; R:=R*TOBSDIF
             "END"; INTERPOL:=S
          "END" INTERPOL;
 
       "PROCEDURE" JAC DYDP(NROW,NCOL,PAR,RES,JAC,LOCFUNCT);
          "VALUE" NROW,NCOL; "INTEGER" NROW,NCOL;
          "ARRAY" PAR,RES,JAC; "PROCEDURE" LOCFUNCT;
          "BEGIN"
             DUPMAT(1,NROW,1,NCOL,JAC,YP)
          "END" JACOBIAN
 
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 16
                                                                 ;
 
 
       "BOOLEAN" "PROCEDURE" FUNCT(NROW,NCOL,PAR,RES);
          "VALUE" NROW,NCOL; "INTEGER" NROW,NCOL; "ARRAY" PAR,RES;
          "BEGIN" "INTEGER" L,K,KNEW,FAILS,SAME,KPOLD,N6,NNPAR,J5N,
             COBSII;
             "REAL" XOLD,HOLD,A0,TOLUP,TOL,TOLDWN,TOLCONV,H,CH,CHNEW,
             ERROR,DFI,TOBSDIF;
             "BOOLEAN" EVALUATE,EVALUATED,DECOMPOSE,CONV;
             "ARRAY" A[0:5],DELTA,LAST DELTA,DF,Y0[1:N],JACOB[1:N,1:N];
             "INTEGER" "ARRAY" P[1:N];
 
             "REAL" "PROCEDURE" NORM2(AI); "REAL" AI;
                "BEGIN" "REAL" S,A; S:= "-100;
                   "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
                   "BEGIN" A:= AI/YMAX[I]; S:= S + A * A "END";
                 NORM2:= S
                "END" NORM2;
 
             "PROCEDURE" RESET;
                "BEGIN" "IF" CH < HMIN/HOLD "THEN" CH:= HMIN/HOLD "ELSE"
                   "IF" CH > HMAX/HOLD "THEN" CH:= HMAX/HOLD;
                   X:= XOLD; H:= HOLD * CH; C:= 1;
                   "FOR" J:= 0 "STEP" N "UNTIL" K*N "DO"
                   "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
                      Y[J+I]:= SAVE[J+I] * C;
                      C:= C * CH
                   "END";
                   DECOMPOSE:="TRUE"
                "END" RESET;
 
             "PROCEDURE" ORDER;
                "BEGIN" C:= EPS * EPS; J:= (K-1) * (K + 8)/2 - 38;
                   "FOR" I:= 0 "STEP" 1 "UNTIL" K "DO" A[I]:= SAVE[I+J];
                   J:= J + K + 1;
                   TOLUP  := C * SAVE[J];
                   TOL    := C * SAVE[J + 1];
                   TOLDWN := C * SAVE[J + 2];
                   TOLCONV:= EPS/(2 * N * (K + 2));
                   A0:= A[0];  DECOMPOSE:= "TRUE";
                "END" ORDER;
 
             "PROCEDURE" EVALUATE JACOBIAN;
                "BEGIN" EVALUATE:= "FALSE";
                   DECOMPOSE:= EVALUATED:= "TRUE";
                   "IF" "NOT" JAC DFDY(PAR,Y,X,FY) "THEN"
                   "BEGIN" SAVE[-3]:=4; "GOTO" RETURN "END";
                "END" EVALUATE JACOBIAN
 
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 17
                                                                 ;
 
 
             "PROCEDURE" DECOMPOSE JACOBIAN;
                "BEGIN" DECOMPOSE:= "FALSE";
                   C:= -A0 * H;
                   "FOR" J:= 1 "STEP" 1 "UNTIL" N "DO"
                   "BEGIN" "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
                      JACOB[I,J]:= FY[I,J] * C;
                      JACOB[J,J]:= JACOB[J,J] + 1
                   "END";
                   DEC(JACOB,N,AUX,P)
                "END" DECOMPOSE JACOBIAN;
 
             "PROCEDURE" CALCULATE STEP AND ORDER;
                "BEGIN" "REAL" A1,A2,A3;
                   A1:= "IF" K <= 1 "THEN" 0 "ELSE"
                        0.75 * (TOLDWN/NORM2(Y[K*N+I])) ** (0.5/K);
                   A2:= 0.80 * (TOL/ERROR) ** (0.5/(K + 1));
                   A3:= "IF" K >= 5 "OR" FAILS ^= 0
                        "THEN" 0 "ELSE"
                        0.70 * (TOLUP/NORM2(DELTA[I] - LAST DELTA[I]))**
                        (0.5/(K+2));
 
                   "IF" A1 > A2 "AND" A1 > A3 "THEN"
                   "BEGIN" KNEW:= K-1; CHNEW:= A1 "END" "ELSE"
                   "IF" A2 > A3 "THEN"
                   "BEGIN" KNEW:= K  ; CHNEW:= A2 "END" "ELSE"
                   "BEGIN" KNEW:= K+1; CHNEW:= A3 "END"
                "END" CALCULATE STEP AND ORDER;
 
             "IF" SEC "THEN" "BEGIN" SEC:="FALSE"; "GOTO" RETURN "END";
             NPAR:=M; EXTRA:=NIS:=0; II:=1;
             JJ:="IF" NBP=0 "THEN" 0 "ELSE" 1;
             N6:=N*6;
             INIVEC(-3,-1,SAVE,0);
             INIVEC(N6+1,(6+M)*N,Y,0);
             INIMAT(1,NOBS+NBP,1,M+NBP,YP,0);
             T:=TOBS[1]; X:=TOBS[0];
             CALL YSTART(PAR,Y,YMAX);
             HMAX:=TOBS[1]-TOBS[0]; HMIN:=HMAX*IN[1];
             EVALUATE JACOBIAN; NNPAR:=N*NPAR;
 
          NEW START:
             K:= 1; KPOLD:=0; SAME:= 2; ORDER;
             "IF" "NOT" DERIV(PAR,Y,X,DF) "THEN"
             "BEGIN" SAVE[-3]:=3; "GOTO" RETURN "END";
             H:=SQRT(2 * EPS/SQRT(NORM2 (MATVEC(1,N,I,FY,DF))));
             "IF" H > HMAX "THEN" H:= HMAX "ELSE"
             "IF" H < HMIN "THEN" H:= HMIN;
             XOLD:= X; HOLD:= H; CH:= 1;
             "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
             "BEGIN" SAVE[I]:=Y[I]; SAVE[N+I]:=Y[N+I]:=DF[I]*H "END";
             FAILS:= 0;
                                                               "COMMENT"
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 18
                                                                 ;
 
 
             "FOR" L:= 0 "WHILE" X < XEND "DO"
             "BEGIN" "IF" X + H <= XEND "THEN" X:= X + H "ELSE"
                "BEGIN" H:= XEND-X; X:= XEND; CH:= H/HOLD; C:= 1;
                   "FOR" J:= N "STEP" N "UNTIL" K*N "DO"
                   "BEGIN" C:= C* CH;
                      "FOR" I:= J+1 "STEP" 1 "UNTIL" J+N "DO"
                      Y[I]:= Y[I] * C
                   "END";
                   SAME:= "IF" SAME<3 "THEN" 3 "ELSE" SAME+1;
                "END";
 
                "COMMENT" PREDICTION;
                "FOR" L:= 1 "STEP" 1 "UNTIL" N "DO"
                "BEGIN" "FOR" I:= L "STEP" N "UNTIL" (K-1)*N+L "DO"
                   "FOR" J:= (K-1)*N+L "STEP" -N "UNTIL" I "DO"
                   Y[J]:= Y[J] + Y[J+N];
                   DELTA[L]:= 0
                "END";  EVALUATED:= "FALSE";
 
                "COMMENT" CORRECTION AND ESTIMATION LOCAL ERROR;
                "FOR" L:= 1,2,3 "DO"
                "BEGIN" "IF" "NOT" DERIV(PAR,Y,X,DF) "THEN"
                   "BEGIN" SAVE[-3]:=3; "GOTO" RETURN "END";
                   "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
                   DF[I]:= DF[I] * H - Y[N+I];
                   "IF" EVALUATE "THEN" EVALUATE JACOBIAN;
                   "IF" DECOMPOSE "THEN" DECOMPOSE JACOBIAN;
                   SOL(JACOB,N,P,DF);
 
                   CONV:= "TRUE";
                   "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
                   "BEGIN" DFI:= DF[I];
                      Y[  I]:= Y[  I] + A0 * DFI;
                      Y[N+I]:= Y[N+I] +      DFI;
                      DELTA[I]:= DELTA[I] +  DFI;
                      CONV:= CONV "AND" ABS(DFI) < TOLCONV * YMAX[I]
                   "END";
                   "IF" CONV "THEN"
                   "BEGIN" ERROR:= NORM2(DELTA[I]);
                      "GOTO" CONVERGENCE
                   "END"
                "END";
 
                "COMMENT" ACCEPTANCE OR REJECTION;
                "IF" "NOT" CONV "THEN"
                "BEGIN" "IF" "NOT" EVALUATED "THEN" EVALUATE:= "TRUE"
                   "ELSE"
                   "BEGIN" CH:=CH/4; "IF" H<4*HMIN "THEN"
                      "BEGIN" SAVE[-1]:= SAVE[-1]+10;
                         HMIN:=HMIN/10;
                                                               "COMMENT"
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 19
                                                                 ;
 
 
                         "IF" SAVE[-1]>40 "THEN" "GOTO" RETURN
                      "END"
                   "END";
                   RESET
                "END" "ELSE" CONVERGENCE:
 
                "IF" ERROR > TOL "THEN"
                "BEGIN" FAILS:= FAILS + 1;
                   "IF" H > 1.1 * HMIN "THEN"
                   "BEGIN" "IF" FAILS > 2 "THEN"
                      "BEGIN"  RESET; "GOTO" NEW START
                      "END" "ELSE"
                      "BEGIN" CALCULATE STEP AND ORDER;
                         "IF" KNEW ^= K "THEN"
                         "BEGIN" K:= KNEW; ORDER "END";
                         CH:= CH * CHNEW; RESET
                      "END"
                   "END" "ELSE"
                   "BEGIN" "IF" K = 1 "THEN"
                      "BEGIN" "COMMENT" VIOLATE EPS CRITERION;
                         SAVE[-2]:= SAVE[-2] + 1;
                         SAME:= 4; "GOTO" ERROR TEST OK
                      "END";
                      K:=1; RESET; ORDER; SAME:= 2
                   "END"
                "END" "ELSE" ERROR TEST OK:
 
                "BEGIN" FAILS:= 0;
                   "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
                   "BEGIN" C:= DELTA[I];
                      "FOR" L:= 2 "STEP" 1 "UNTIL" K "DO"
                      Y[L*N+I]:= Y[L*N+I] + A[L] * C;
                      "IF" ABS(Y[I]) > YMAX[I] "THEN"
                      YMAX[I]:=  ABS(Y[I])
                   "END";
 
                   SAME:= SAME-1;
                   "IF" SAME= 1 "THEN"
                   DUPVEC(1,N,0,LAST DELTA,DELTA) "ELSE"
                   "IF" SAME= 0 "THEN"
                   "BEGIN" CALCULATE STEP AND ORDER;
                      "IF" CHNEW > 1.1 "THEN"
                      "BEGIN"
                         "IF" K ^= KNEW "THEN"
                         "BEGIN" "IF" KNEW > K "THEN"
                            MULVEC(KNEW*N+1,KNEW*N+N,-KNEW*N,Y,DELTA,
                            A[K]/KNEW);
                            K:= KNEW; ORDER
                         "END";
                         SAME:= K+1;
                         "IF" CHNEW * H > HMAX
                         "THEN" CHNEW:= HMAX/H;
                                                               "COMMENT"
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 20
                                                                 ;
 
 
                         H:= H * CHNEW; C:= 1;
                         "FOR" J:= N "STEP" N "UNTIL" K*N "DO"
                         "BEGIN" C:= C * CHNEW;
                            MULVEC(J+1,J+N,0,Y,Y,C)
                         "END"; DECOMPOSE:="TRUE"
                      "END"
                      "ELSE" SAME:= 10
                   "END" OF A SINGLE INTEGRATION STEP OF Y;
                   NIS:=NIS+1;
 
                   "COMMENT" START OF A INTEGRATION STEP OF YP;
                   "IF" CLEAN "THEN"
                   "BEGIN" HOLD:=H; XOLD:=X; KPOLD:=K; CH:=1;
                      DUPVEC(1,K*N+N,0,SAVE,Y)
                   "END" "ELSE"
                   "BEGIN" "IF" H^=HOLD "THEN"
                      "BEGIN" CH:=H/HOLD; C:=1;
                         "FOR" J:=N6+NNPAR "STEP" NNPAR "UNTIL"
                         KPOLD*NNPAR+N6 "DO"
                         "BEGIN" C:=C*CH;
                            "FOR" I:=J+1 "STEP" 1 "UNTIL" J+NNPAR "DO"
                            Y[I]:=Y[I]*C
                         "END"; HOLD:=H
                      "END";
                      "IF" K>KPOLD "THEN"
                      INIVEC(N6+K*NNPAR+1,N6+K*NNPAR+NNPAR,Y,0);
                      XOLD:= X; KPOLD:= K; CH:= 1;
                      DUPVEC(1,K*N+N,0,SAVE,Y);
                      EVALUATE JACOBIAN;
                      DECOMPOSE JACOBIAN;
                      "IF" "NOT" JAC DFDP(PAR,Y,X,FP) "THEN"
                      "BEGIN" SAVE[-3]:=5; "GOTO" RETURN "END";
                      "IF" NPAR>M "THEN" INIMAT(1,N,M+1,NPAR,FP,0);
 
                      "COMMENT" PREDICTION;
                      "FOR" L:=0 "STEP" 1 "UNTIL" K-1 "DO"
                      "FOR" J:=K-1 "STEP" -1 "UNTIL" L "DO"
                      ELMVEC(J*NNPAR+N6+1,J*NNPAR+N6+NNPAR,NNPAR,Y,Y,1);
 
                      "COMMENT" CORRECTION;
                      "FOR" J:=1 "STEP" 1 "UNTIL" NPAR "DO"
                      "BEGIN" J5N:=(J+5)*N;
                         DUPVEC(1,N,J5N,Y0,Y);
                         "FOR" I:=1 "STEP" 1 "UNTIL" N "DO" DF[I]:=
                         H*(FP[I,J]+MATVEC(1,N,I,FY,Y0))
                         -Y[NNPAR+J5N+I];
                         SOL(JACOB,N,P,DF);
                         "FOR" L:=0 "STEP" 1 "UNTIL" K "DO"
                         "BEGIN" I:=L*NNPAR+J5N;
                            ELMVEC(I+1,I+N,-I,Y,DF,A[L])
                         "END"
                      "END"
                   "END";
                                                               "COMMENT"
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 21
                                                                 ;
 
 
                   "FOR" L:=0 "WHILE" X>=T "DO"
                   "BEGIN"
                      "COMMENT" CALCULATION OF A ROW OF THE JACOBIAN
                                MATRIX AND AN ELEMENT OF THE RESIDUAL
                                VECTOR;
                      TOBSDIF:=(TOBS[II]-X)/H; COBSII:=COBS[II];
                      RES[II]:=INTERPOL(COBSII,N,K,TOBSDIF)-OBS[II];
                      "IF" "NOT" CLEAN "THEN"
                      "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" NPAR "DO"
                         YP[II,I]:=INTERPOL(COBSII+(I+5)*N,NNPAR,K,
                                            TOBSDIF);
 
                         "COMMENT" INTRODUCING OF BREAK-POINTS;
                         "IF" BP[JJ]^=II "THEN" "ELSE"
                         "IF" FIRST "AND" ABS(RES[II])<EPS1 "THEN"
                         "BEGIN" NBP:=NBP-1; "COMMENT" DUPVEC(BP) ;
                             "FOR" I:= JJ "STEP" 1 "UNTIL" NBP "DO"
                             BP[I]:= BP[I + 1]; BP[NBP+1]:=0
                         "END" "ELSE"
                         "BEGIN" EXTRA:=EXTRA+1;
                            "IF" FIRST "THEN" PAR[M+JJ]:=OBS[II];
                            "COMMENT" INTRODUCING A JACOBIAN ROW AND A
                                      RESIDUAL VECTOR ELEMENT FOR
                                      CONTINUITY REQUIREMENTS;
                            YP[NOBS+JJ,M+JJ]:=-WEIGHT;
                            MULROW(1,NPAR,NOBS+JJ,II,YP,YP,WEIGHT);
                            RES[NOBS+JJ]:=WEIGHT*(RES[II]+OBS[II]-
                                          PAR[M+JJ])
                         "END"
                      "END";
 
                      "IF" II=NOBS "THEN" "GOTO" RETURN "ELSE"
                      "BEGIN" T:=TOBS[II+1];
                         "IF" BP[JJ]=II "AND" JJ<NBP "THEN" JJ:=JJ+1;
                         HMAX:=T-TOBS[II]; HMIN:=HMAX*IN[1]; II:=II+1
                      "END";
                   "END";
 
                   "COMMENT" BREAK-POINTS INTRODUCE NEW INITIAL VALUES
                             FOR Y AND YP;
                   "IF" EXTRA>0 "THEN"
                   "BEGIN" "FOR" I:=1 "STEP" 1 "UNTIL" N "DO"
                      "BEGIN" Y[I]:=INTERPOL(I,N,K,TOBSDIF);
                         "FOR" J:=1 "STEP" 1 "UNTIL" NPAR "DO"
                         Y[I+(J+5)*N]:=INTERPOL(I+(J+5)*N,NNPAR,K,
                                                TOBSDIF)
                      "END";
                      "FOR" L:=1 "STEP" 1 "UNTIL" EXTRA "DO"
                      "BEGIN"  COBSII:=COBS[BP[NPAR-M+L]];
                         Y[COBSII]:=PAR[NPAR+L];
                         "FOR" I:=1 "STEP" 1 "UNTIL" NPAR+EXTRA "DO"
                         Y[COBSII+(5+I)*N]:=0;
                                                               "COMMENT"
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 22
                                                                 ;
 
 
                         INIVEC(1+NNPAR+(L+5)*N,NNPAR+(L+6)*N,Y,0);
                         Y[COBSII+(5+NPAR+L)*N]:=1
                      "END";
                      NPAR:=NPAR+EXTRA; EXTRA:=0;
                      X:=TOBS[II-1]; EVALUATE JACOBIAN; NNPAR:=N*NPAR;
                      "GOTO" NEW START
                   "END"
                "END"
             "END" STEP;
 
           RETURN:
             "IF" SAVE[-2]>MAX "THEN" MAX:=SAVE[-2];
             FUNCT:=SAVE[-1]<=40 "AND" SAVE[-3]=0;
             "IF" "NOT" FIRST "THEN"
             MONITOR(1,NCOL,NROW,PAR,RES,WEIGHT,NIS)
          "END" FUNCT;
 
 
       I:= -39;
       "FOR" C:= 1,1,9,4,0,2/3,1,1/3,36,20.25,1,6/11,
                 1,6/11,1/11,84.028,53.778,0.25,.48,1,.7,.2,.02,
                 156.25, 108.51, .027778, 120/274, 1, 225/274,
                 85/274, 15/274, 1/274, 0, 187.69, .0047361
       "DO" "BEGIN" I:= I + 1; SAVE[I]:= C "END";
 
       DATA(NOBS,TOBS,OBS,COBS); WEIGHT:=1;
       FIRST:=SEC:="FALSE"; CLEAN:=NBP>0;
       AUX[2]:="-12; EPS:=IN[2]; EPS1:="10;
       XEND:=TOBS[NOBS]; OUT[1]:=0; BP[0]:=MAX:=0;
 
       "COMMENT" SMOOTH INTEGRATION WITHOUT BREAK-POINTS;
       "IF" "NOT" FUNCT(NOBS,M,PAR,RES) "THEN" "GOTO" ESCAPE;
       RES1:=SQRT(VECVEC(1,NOBS,0,RES,RES)); NFE:=1;
       "IF" IN[5]=1 "THEN"
       "BEGIN" OUT[1]:=1; "GOTO" ESCAPE "END";
 
       "IF" CLEAN "THEN"
       "BEGIN" FIRST:="TRUE"; CLEAN:="FALSE";
          FAC3:=SQRT(SQRT(IN[3]/RES1)); FAC4:=SQRT(SQRT(IN[4]/RES1));
          EPS1:=RES1*FAC4;
          "IF" "NOT" FUNCT(NOBS,M,PAR,RES) "THEN" "GOTO" ESCAPE;
          FIRST:="FALSE"
       "END" "ELSE" NFE:=0;
 
       NCOL:=M+NBP; NROW:=NOBS+NBP;
       SEC:="TRUE";
       IN3:=IN[3]; IN4:=IN[4]; IN[3]:=RES1;
 
       "BEGIN" "REAL" W; "ARRAY" AID[1:NCOL,1:NCOL];
          WEIGHT:=AWAY:=0;
          OUT[4]:=OUT[5]:=W:=0;
                                                               "COMMENT"
1SECTION : 5.2.1.3.1         (OCTOBER 1975)                     PAGE 23
                                                                 ;
 
 
 
          "FOR" WEIGHT:=(SQRT(WEIGHT)+1)**2 "WHILE"
          WEIGHT^=16 "AND" NBP>0 "DO"
 
          "BEGIN" "IF" AWAY=0 "AND" W^=0 "THEN"
             "BEGIN" "COMMENT" IF NO BREAK-POINTS WERE OMITTED THEN ONE
                               FUNCTION EVALUATION IS SAVED;
                W:=WEIGHT/W;
                "FOR" I:=NOBS+1 "STEP" 1 "UNTIL" NROW "DO"
                "BEGIN" "FOR" J:=1 "STEP" 1 "UNTIL" NCOL "DO"
                   YP[I,J]:=W*YP[I,J];
                   RES[I]:=W*RES[I]
                "END"; SEC:="TRUE"; NFE:=NFE-1
             "END";
 
             IN[3]:=IN[3]*FAC3*WEIGHT; IN[4]:=EPS1;
             MONITOR(2,NCOL,NROW,PAR,RES,WEIGHT,NIS);
             MARQUARDT(NROW,NCOL,PAR,RES,AID,FUNCT,JAC DYDP,IN,OUT);
             "IF" OUT[1]>0 "THEN" "GOTO" ESCAPE;
 
             "COMMENT" THE RELATIVE STARTING VALUE OF LAMBDA IS
                       ADJUSTED TO THE LAST VALUE OF LAMBDA USED;
             AWAY:=OUT[4]-OUT[5]-1;
             IN[6]:=IN[6] * 5**AWAY * 2**(AWAY-OUT[5]);
 
             NFE:=NFE+OUT[4];
             W:=WEIGHT; EPS1:=(SQRT(WEIGHT)+1)**2*IN[4]*FAC4;
             AWAY:=0;
 
             "COMMENT" USELESS BREAK-POINTS ARE OMITTED;
             J:= 0; "FOR" J:= J + 1 "WHILE" J "LE" NBP "DO"
             "BEGIN" "IF" ABS(OBS[BP[J]]+RES[BP[J]]-PAR[J+M])<EPS1
                "THEN"
                "BEGIN" NBP:=NBP-1; "COMMENT" DUPVEC (BP) ;
                   "FOR" I:= J "STEP" 1 "UNTIL" NBP "DO"
                   BP[I]:= BP[I + 1];
                   DUPVEC(J+M,NBP+M,1,PAR,PAR);
                   J:=J-1; AWAY:=AWAY+1; BP[NBP+1]:=0
                "END"
             "END";
             NCOL:=NCOL-AWAY; NROW:=NROW-AWAY
          "END";
 
          IN[3]:=IN3; IN[4]:=IN4; NBP:=0; WEIGHT:=1;
          MONITOR(2,M,NOBS,PAR,RES,WEIGHT,NIS);
          MARQUARDT(NOBS,M,PAR,RES,JTJINV,FUNCT,JAC DYDP,IN,OUT);
          NFE:=OUT[4]+NFE
       "END";
      ESCAPE: "IF" OUT[1]=3 "THEN" OUT[1]:=2 "ELSE"
              "IF" OUT[1]=4 "THEN" OUT[1]:=6;
              "IF" SAVE[-3]^=0 "THEN" OUT[1]:=SAVE[-3];
              OUT[3]:=RES1;
              OUT[4]:=NFE;
              OUT[5]:=MAX
    "END" PEIDE;
         "EOP"
1SECTION : 6.1               (JANUARY 1976)                      PAGE 1
 
 
 
 AUTHOR: D.T.WINTER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 751208.
 
 
 BRIEF DESCRIPTION:
     THIS SECTION CONTAINS TWO PROCEDURES:
     1)  PI: DELIVERS THE VALUE OF PI;
     2)  E:  DELIVERS THE VALUE OF E.
 
 
 KEYWORDS:
 
     MATHEMATICAL CONSTANTS
     PI
     E
 
 
 SUBSECTION: PI
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" PI;
     "CODE" 30006;
 
     PI:= THE CONSTANT PI IN 48 BITS PRECISION.
 
 LANGUAGE: COMPASS
 
 
 SUBSECTION: E
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" E;
     "CODE" 30007;
 
     E:= THE CONSTANT E IN 48 BITS PRECISION.
 
 LANGUAGE: COMPASS
1SECTION : 6.1                (JANUARY 1976)                      PAGE 2
 
 
 
 SOURCE TEXTS:
0 THE SOURCE TEXTS  GIVEN HERE  ARE NOT THE ACTUAL  SOURCE TEXTS,  AS
  THESE PROCEDURES ARE WRITTEN IN COMPASS. EVEN, THE TEXTS GIVEN
  HERE DO NOT GIVE THE SAME RESULTS ON THE CDC CYBER SYSTEM, SINCE
  THE ALGOL-60 COMPILER CANNOT READ THE CONSTANTS IN 48 BIT PRECISION.
 
0"CODE" 30006;
 "REAL" "PROCEDURE" PI;
 PI:= 3.14159265358979;
         "EOP"
 
0"CODE" 30007;
 "REAL" "PROCEDURE" E;
 E:= 2.71828182845905;
         "EOP"
1SECTION : 6.2                (JANUARY 1979)                      PAGE 1
 
 
 
 AUTHOR: D.T.WINTER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE,AMSTERDAM.
 
 
 RECEIVED: 751208.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS SEVEN PROCEDURES:
     A)  MBASE: DELIVERS THE BASE OF THE ARITHMETIC OF THE COMPUTER;
     B)  ARREB: DELIVERS THE ARITHMETIC ERROR BOUND OF THE COMPUTER;
     C)  DWARF: DELIVERS THE SMALLEST  (IN ABSOLUTE VALUE) REPRESENTABLE
             REAL NUMBER;
     D)  GIANT: DELIVERS THE LARGEST REPRESENTABLE REAL NUMBER;
     E)  INTCAP: DELIVERS THE INTEGER CAPACITY;
     F)  OVERFLOW: TESTS WHETHER A VALUE IS AN OVERFLOW VALUE;
     G)  UNDERFLOW: TESTS WHETHER A VALUE IS AN UNDERFLOW VALUE;
     FOR A DETAILED DESCRIPTION SEE METHOD AND PERFORMANCE.
 
 
 KEYWORDS:
 
     ARITHMETIC CONSTANTS
     MACHINE CONSTANTS
     OVERFLOW
     UNDERFLOW
 
 
 SUBSECTION: MBASE
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "INTEGER" "PROCEDURE" MBASE;
     "CODE" 30001;
 
     MBASE:= 2, THE BASE OF THE ARITHMETIC OF THE CYBER.
 
 LANGUAGE: COMPASS
 
 
 SUBSECTION: ARREB
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" ARREB;
     "CODE" 30002;
 
     ARREB:= 2 ** (-47), THE ARITHMETIC RELATIVE ERROR BOUND.
 
 LANGUAGE: COMPASS
 
 
1SECTION : 6.2                (DECEMBER 1979)                     PAGE 2
 
 
 
 SUBSECTION: DWARF
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" DWARF;
     "CODE" 30003;
 
     DWARF:= THE SMALLEST (IN ABSOLUTE VALUE) REPRESENTABLE REAL NUMBER.
 
 LANGUAGE: COMPASS
 
 
 SUBSECTION: GIANT
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" GIANT;
     "CODE" 30004;
 
     GIANT:= THE LARGEST REPRESENTABLE REAL NUMBER.
 
 LANGUAGE: COMPASS
 
 
 SUBSECTION: INTCAP
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "INTEGER" "PROCEDURE" INTCAP;
     "CODE" 30005;
 
     INTCAP:= THE INTEGER CAPACITY.
 
 LANGUAGE: COMPASS
 
 
 SUBSECTION: OVERFLOW
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "BOOLEAN" "PROCEDURE" OVERFLOW(X); "VALUE" X; "REAL" X;
     "CODE" 30008;
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:  <REAL VARIABLE>;
         CONTAINS THE VALUE TO BE TESTED.
 
     OVERFLOW  DELIVERS  "TRUE"  IF  X  CONTAINS AN OVERFLOW VALUE,  AND
     "FALSE" OTHERWISE.
 
 LANGUAGE: COMPASS
1SECTION : 6.2                (DECEMBER 1979)                     PAGE 3
 
 
 
 SUBSECTION: UNDERFLOW
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "BOOLEAN" "PROCEDURE" UNDERFLOW(X); "VALUE" X; "REAL" X;
     "CODE" 30009;
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:  <REAL VARIABLE>;
         CONTAINS THE VALUE TO BE TESTED.
 
     UNDERFLOW DELIVERS  "TRUE"  IF  X CONTAINS AN UNDERFLOW VALUE,  AND
     "FALSE" OTHERWISE.
 
 LANGUAGE: COMPASS
 
 METHOD AND PERFORMANCE:
 
     THE PROCEDURES DELIVER  THE FOLLOWING VALUES,  THAT ARE ESSENTIALLY
     MACHINE DEPENDENT:
     1)  MBASE: 2;
     2)  ARREB: 2**(-47);
     3)  DWARF: 2**48*2**(-1022);
     4)  GIANT: (2**48-1)*2**1022;
     5)  INTCAP: 2**48-2.
     FOR MBASE,  DWARF AND  GIANT THE VALUES  ARE CLEAR,  WE EXPLAIN THE
     OTHERS HERE:
     ARREB: THIS IS THE SMALLEST POSITIVE NUMBER SO THAT 1+ARREB^=1;
     INTCAP: THIS IS  THE LARGEST POSITIVE NUMBER  SO THAT THE FOLLOWING
         BOOLEAN EXPRESSION DELIVERS "TRUE" FOR EVERY INTEGER I:
             "IF" I<0 "OR" I>INTCAP "THEN" "TRUE" "ELSE" I-1^=I;
         THE CORRECT VALUE IS NOT  2**48-1,  AS IN THE  CYBER ARITHMETIC
         I=J IF I=2**48 AND J=2**48-1.
     WARNING: DWARF IS NOT VERY USEFUL WHEN TRAPPING UNDERFLOW VALUES:
         ABS(X) >= DWARF  NEARLY ALWAYS  DELIVERS TRUE EVEN IF ABS(X) IS
         SMALLER  THEN  DWARF  DUE  TO THE ARITHMETIC.  ONE  SHOULD USE:
         ABS(X) > DWARF  (AND  ONE  TRAPS  NON-UNDERFLOW VALUES TOO)  OR
         THE PROCEDURE UNDERFLOW.
     NOTE: AS THE ALGOL 60 ERRORMESSAGE "ARITHMETIC OVERFLOW"
         IS NOT ISSUED AT THE MOMENT THE OVERFLOW VALUE
         IS CREATED BUT WHEN SUCH A VALUE IS USED, THE
         PROCEDURE OVERFLOW IS WELL-DEFINED.
 
 
1SECTION : 6.2                (DECEMBER 1979)                     PAGE 4
 
 
 
 EXAMPLE OF USE:
 
 
     HERE WE GIVE  AN EXAMPLE  OF USE  OF THE  PROCEDURES  OVERFLOW  AND
     UNDERFLOW:
 
     "BEGIN"
         "REAL" X, Y;
         Y:= 0; X:= 1 / Y;
         "IF" OVERFLOW(X) "THEN" OUTPUT(61, "(""("OVERFLOW")", /")");
         X:= DWARF; Y:= 2.0;
         "IF" "NOT" UNDERFLOW(X) "THEN"
         OUTPUT(61, "(""("NO UNDERFLOW WITH DWARF")", /")");
         X:= X / Y;
         "IF" X ^= 0 "THEN"
         OUTPUT(61, "(""("DWARF / 2 ^= 0")", /")");
         "IF" UNDERFLOW(X) "THEN"
         OUTPUT(61, "(""("DWARF / 2 IS UNDERFLOW")", /")");
         "IF" X * Y = 0 "THEN"
         OUTPUT(61, "(""("BECAUSE (DWARF / 2) * 2 = 0")", /")")
     "END"
 
     RESULTS:
     OVERFLOW
     NO UNDERFLOW WITH DWARF
     DWARF / 2 ^= 0
     DWARF / 2 IS UNDERFLOW
     BECAUSE (DWARF / 2) * 2 = 0
1SECTION : 6.2                (JANUARY 1976)                      PAGE 5
 
 
 
 SOURCE TEXTS:
 
     THESE  ARE NOT  THE ACTUAL  SOURCE TEXTS,  AS THESE  PROCEDURES ARE
     WRITTEN IN COMPASS,  MOREOVER,  THE RESULTS NEED NOT BE THAT OF THE
     ACTUAL PROCEDURES.
 
     THE SOURCE TEXTS OF OVERFLOW AND UNDERFLOW  ARE NOT GIVEN HERE,  AS
     THESE EVEN CANNOT BE SIMULATED IN ALGOL-60.
 
 "CODE" 30001;
 "INTEGER" "PROCEDURE" MBASE;
 MBASE:= 2;
         "EOP"
 
 "CODE" 30002;
 "REAL" "PROCEDURE" ARREB;
 ARREB:= 2**(-47);
         "EOP"
 
 "CODE" 30003;
 "REAL" "PROCEDURE" DWARF;
 DWARF:= 2**48*2**(-1022);
         "EOP"
 
 "CODE" 30004;
 "REAL" "PROCEDURE" GIANT;
 GIANT:= (2**48-1)*2**1022;
         "EOP"
 
 "CODE" 30005;
 "INTEGER" "PROCEDURE" INTCAP;
 INTCAP:= 2**48-2;
         "EOP"
1SECTION : 6.4.1              (DECEMBER 1979)                     PAGE 1
 
 
 
 AUTHOR: P.W.HEMKER.
 
 
 CONTRIBUTOR: F.GROEN.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 740620.
 
 
 REVISED: 781101 BY N.M.TEMME  AND R.MONTIJN.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THREE PROCEDURES: TAN, ARCSIN, ARCCOS.
 
     TAN COMPUTES THE TANGENT FOR A REAL ARGUMENT X.
     ARCSIN COMPUTES THE ARCSINE FOR A REAL ARGUMENT X.
     ARCCOS COMPUTES THE ARCCOSINE FOR A REAL ARGUMENT X.
 
 KEYWORDS:
 
     TANGENT,
     ARCSINE,
     ARCCOSINE.
1SECTION : 6.4.1              (DECEMBER 1979)                     PAGE 2
 
 
 
 SUBSECTION: TAN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" TAN(X); "VALUE" X; "REAL" X;
     "CODE" 35120;
 
     TAN : DELIVERS THE TANGENT OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF TAN(X).
 
 
 PROCEDURES USED : OVERFLOW  =  CP 30008,
                   GIANT     =  CP 30004.
 
 
 METHOD AND PERFORMANCE :
 
     THE FORMULA TAN(X) = SIN(X) / COS(X) IS USED. IF COS(X) = 0 THEN
     THE VALUE OF GIANT (SEE SECTION 6.2) IS DELIVERED.
 
 EXAMPLE OF USE:
 
     "BEGIN"
         OUTPUT(61,"("/"("ARCTAN(TAN(1))= ")",+D.14D")",ARCTAN(TAN(1)));
         OUTPUT(61,"("/"("ARCTAN(TAN(0))= ")",+D.14D")",ARCTAN(TAN(0)));
         OUTPUT(61,"("/"("TAN(ARCTAN(0))= ")",+D.14D")",TAN(ARCTAN(0)));
         OUTPUT(61,"("/"("TAN(ARCTAN(1))= ")",+D.14D")",TAN(ARCTAN(1)));
     "END"
 
 DELIVERS :
 
     ARCTAN(TAN(1))= +1.00000000000000
     ARCTAN(TAN(0))= +0.00000000000000
     TAN(ARCTAN(0))= +0.00000000000000
     TAN(ARCTAN(1))= +1.00000000000000
1SECTION : 6.4.1              (DECEMBER 1979)                     PAGE 3
 
 
 
 SUBSECTION : ARCSIN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" ARCSIN(X); "VALUE" X; "REAL" X;
     "CODE" 35121;
 
     ARCSIN : DELIVERS THE ARCSINE OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF ARCSIN(X), ABS(X)<=1.
 
 
 PROCEDURES USED : NONE.
 
 
 METHOD AND PERFORMANCE :
 
     FOR ABS(X) < 0.8 WE USE  THE FORMULA :
         ARCSIN(X) = ARCTAN( X / SQRT ( 1 - X * X )).
     FOR 0.8 <= ABS(X) < 1 WE USE THE FORMULA :
         ARCSIN(X) = SIGN(X) * ( PI/2 - ARCTAN( SQRT( 1/( X * X) - 1))).
     FOR ABS(X) = 1 THE VALUE SIGN(X) * PI/2 IS DELIVERED.
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
 
 EXAMPLE OF USE :
 
     "BEGIN"
         OUTPUT(61,"("/"("ARCSIN(SIN(1))= ")",+D.14D")",ARCSIN(SIN(1)));
         OUTPUT(61,"("/"("ARCSIN(SIN(0))= ")",+D.14D")",ARCSIN(SIN(0)));
         OUTPUT(61,"("/"("SIN(ARCSIN(0))= ")",+D.14D")",SIN(ARCSIN(0)));
         OUTPUT(61,"("/"("SIN(ARCSIN(1))= ")",+D.14D")",SIN(ARCSIN(1)));
     "END"
 
     DELIVERS :
 
     ARCSIN(SIN(1))= +0.99999999999990
     ARCSIN(SIN(0))= +0.00000000000000
     SIN(ARCSIN(0))= +0.00000000000000
     SIN(ARCSIN(1))= +1.00000000000000
1SECTION : 6.4.1              (DECEMBER 1979)                     PAGE 4
 
 
 
 SUBSECTION: ARCCOS.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" ARCCOS(X); "VALUE" X; "REAL" X;
     "CODE" 35122;
 
     ARCCOS : DELIVERS THE ARCCOSINE OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF ARCCOS(X), ABS(X)<=1.
 
 
 PROCEDURES USED: NONE.
 
 
 METHOD AND PERFORMANCE:
 
     FOR 0 < X < 1 WE USE THE FORMULA:
         ARCCOS(X) = 2 * ARCTAN( SQRT( (1 - X) / (1 + X))).
     FOR -1 < X <= 0 WE USE THE FORMULA:
         ARCCOS(X) = PI - ARCCOS(-X).
     FOR X =  1 THE VALUE 0  IS DELIVERED.
     FOR X = -1 THE VALUE PI IS DELIVERED.
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF "-13.
 
 EXAMPLE OF USE:
 
     "BEGIN"
         OUTPUT(61,"("/"("ARCCOS(COS(1))= ")",+D.14D")",ARCCOS(COS(1)));
         OUTPUT(61,"("/"("ARCCOS(COS(0))= ")",+D.14D")",ARCCOS(COS(0)));
         OUTPUT(61,"("/"("COS(ARCCOS(0))= ")",+D.14D")",COS(ARCCOS(0)));
         OUTPUT(61,"("/"("COS(ARCCOS(1))= ")",+D.14D")",COS(ARCCOS(1)));
     "END"
 
     DELIVERS :
 
     ARCCOS(COS(1))= +1.00000000000000
     ARCCOS(COS(0))= +0.00000000000000
     COS(ARCCOS(0))= +0.00000000000001
     COS(ARCCOS(1))= +1.00000000000000
1SECTION : 6.4.1              (DECEMBER 1979)                     PAGE 5
 
 
 
 SOURCE TEXTS:
0"CODE" 35120;
 "REAL" "PROCEDURE" TAN(X); "VALUE" X; "REAL" X;
 "BEGIN" "REAL" U;
     U:= SIN(X)/COS(X);
     TAN:= "IF" OVERFLOW(U) "THEN" GIANT "ELSE" U
 "END" TAN;
         "EOP"
 
 "CODE" 35121;
 "REAL" "PROCEDURE" ARCSIN(X); "VALUE" X; "REAL" X;
 "BEGIN" "REAL" U; U:= ABS(X);
     ARCSIN:= "IF" U<0.8 "THEN" ARCTAN(X/SQRT(1-X*X)) "ELSE"
              SIGN(X) * ( "IF" U=1  "THEN" 1.57079632679489 "ELSE"
              ( 1.57079632679489 - ARCTAN(SQRT(1/(X*X)-1))))
 "END" ARCSIN;
         "EOP"
 
 "CODE" 35122;
 "REAL" "PROCEDURE" ARCCOS(X); "VALUE" X; "REAL" X;
 "BEGIN" "REAL" U,V; U:= ABS(X); V:= (1-U)/(1+U);
     V:= "IF" V  =0 "THEN" 0 "ELSE"
         "IF" U+1=1 "THEN" 1.57079632679489 "ELSE"
                           2*ARCTAN(SQRT(V));
     ARCCOS:= "IF" X>0 "THEN" V "ELSE" 3.14159265358979 - V
 "END" ARCCOS;
         "EOP"
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 1
 
 
 
 AUTHOR: P.W.HEMKER.
 
 
 CONTRIBUTOR: F.GROEN.
 
 
 INSTITUTE: MATHEMATICAL CENTRE, AMSTERDAM.
 
 
 RECEIVED: 730921.
 
 
 REVISED: 781101 BY N.M.TEMME AND R.MONTIJN.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS SIX  PROCEDURES  FOR THE COMPUTATION OF
     HYPERBOLIC FUNCTIONS.
 
     SINH COMPUTES FOR A REAL ARGUMENT X THE VALUE OF SINH(X).
     COSH COMPUTES FOR A REAL ARGUMENT X THE VALUE OF COSH(X).
     TANH COMPUTES FOR A REAL ARGUMENT X THE VALUE OF TANH(X).
     ARCSINH COMPUTES FOR A REAL ARGUMENT X THE VALUE OF ARCSINH(X).
     ARCCOSH COMPUTES FOR A REAL ARGUMENT X THE VALUE OF ARCCOSH(X).
     ARCTANH COMPUTES FOR A REAL ARGUMENT X THE VALUE OF ARCTANH(X).
 
 KEYWORDS:
 
     HYPERBOLIC SINE,
     HYPERBOLIC COSINE,
     HYPERBOLIC TANGENT,
     HYPERBOLIC ARCSINE,
     HYPERBOLIC ARCCOSINE,
     HYPERBOLIC ARCTANGENT.
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 2
 
 
 
 SUBSECTION : SINH.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" SINH(X); "VALUE" X; "REAL" X;
     "CODE" 35111;
 
     SINH : DELIVERS THE HYPERBOLIC SINE OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF SINH(X).
 
 
 PROCEDURES USED : OVERFLOW  =  CP 30009,
                   GIANT     =  CP 30004.
 
 
 METHOD AND PERFORMANCE :
 
     IF ABS(X) < 0.1 THEN SINH(X) IS CALCULATED BY MEANS OF AN
     ECONOMIZED TAYLOR SERIES.
     IF 0.1 <= ABS(X) < 0.3 WE USE THE FORMULA :
         SINH(X) = 3 * SINH ( X/3 ) + 4 * SINH ( X/3 ) ** 3
     IF 0.3 <= ABS(X) < 17.5 THEN WE USE THE FORMULA :
         SINH(X) = 0.5 * ( EXP(X) - EXP(-X) ).
     IF X >= 17.5 THEN WE TAKE SINH(X) = SIGN(X) * EXP( X-LN(2) ).
     IN THE CASE OF OVERFLOW (I.E., ABS(X) > 741.6 (APPROXIMATELY))
          THEN THE VALUE SINH = SIGN(X) * GIANT ( SEE SUBSECTION 6.2)
          IS DELIVERED.
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
 
 
 EXAMPLE OF USE :
 
     SEE EXAMPLE OF USE OF THE PROCEDURE COSH (THIS SECTION).
 
 
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 3
 
 
 
 SUBSECTION : COSH.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" COSH(X); "VALUE" X; "REAL" X;
     "CODE" 35112;
 
     COSH : DELIVERS THE HYPERBOLIC COSINE OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF COSH(X).
 
 
 PROCEDURES USED : SINH  =  CP 35111.
 
 
 METHOD AND PERFORMANCE :
 
     IF ABS(X) < 17.5 THE FORMULA  COSH(X) = 0.5 * ( EXP(X) + EXP(-X) )
     IS USED ELSE COSH(X) = SINH(ABS(X)).
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
 
 
 EXAMPLE OF USE :
 
     THE FOLLOWING PROGRAM TESTS FOR X = -20, -2, -1, 0.1, 0.3 THE
     RELATION : SINH(2 * X) - 2 * SINH(X) * COSH(X) = 0.
 
     "BEGIN""REAL" X;
 
         "FOR" X := -20, -2, -1, 0.1, 0.3  "DO"
         OUTPUT(61,"("/,+2ZD.2D,3B,+D.D"+3D")",X,SINH(2 * X)
         - 2 * SINH(X) * COSH(X) );
     "END"
 
     OUTPUT :
 
     -20.00   +6.1"+003
      -2.00   -1.1"-013
      -1.00   -1.4"-014
      +0.10   +0.0"+000
      +0.30   +0.0"+000
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 4
 
 
 
 SUBSECTION : TANH.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" TANH(X); "VALUE" X; "REAL" X;
     "CODE" 35113;
 
     TANH : DELIVERS THE HYPERBOLIC TANGENT OF TH ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF TANH(X).
 
 
 PROCEDURES USED : SINH  =  CP 35111.
 
 
 METHOD AND PERFORMANCE :
 
     IF ABS(X) < 0.005 THE TANH(X) IS CALCULATED BY A TRUNCATED
     POWER SERIES (TAYLOR'S FORMULA).
     IF 0.005 <= ABS(X) < 0.3 WE USE THE FORMULA :
         TANH(X) = SINH(X) / COSH(X).
     IF 0.3 <= ABS(X) <= 17.5  WE USE THE FORMULA :
         TANH(X) = ( 1 - EXP( -2 * X ) ) / ( 1 + EXP( -2 * X ) ).
     IF ABS(X) > 17.5 THE VALUE SIGN(X) IS DELIVERED.
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
 
 
 EXAMPLE OF USE :
 
     THE FOLLOWING PROGRAM CHECKS FOR X = -100, -10, 0, 2, 5 THE
     RELATION : 1 - TANH(X) ** 2 - 1 / COSH(X) ** 2 = 0.
 
     "BEGIN" "REAL" X ;
       "FOR" X := -100, -10, 0, 2, 5 "DO"
       OUTPUT(61,"("/,+2ZD,3B,+D.D"+3D")",X,1-TANH(X)**2-1/COSH(X)**2);
     "END"
 
     RESULTS :
 
     -100   -5.5"-087
      -10   +1.2"-014
       +0   +0.0"+000
       +2   +9.8"-015
       +5   -3.4"-015
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 5
 
 
 
 SUBSECTION : ARCSINH.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" ARCSINH(X); "VALUE" X; "REAL" X;
     "CODE" 35114;
 
     ARCSINH : DELIVERS THE INVERSE HYPERBOLIC SINE OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF ARCSINH(X).
 
 
 PROCEDURES USED : LOG ONE PLUS X  =  CP 35130.
 
 
 METHOD AND PERFORMANCE :
 
     IF ABS(X) <= "10 WE USE THE PROCEDURE LOG ONE PLUS X (SEE SECTION
         6.4.3.) BY WRITING :
         ARCSINH(X) = LN ( X + SQRT ( X * X + 1 ) ) =
         LN(1+X+X**2/(1+SQRT(1+X**2))).
     IF ABS(X) > "10 WE USE THE FORMULA :
         ARCSINH(X) = SIGN(X) * ( LN(2) + LN ( ABS(X) ) ).
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
 
 
 EXAMPLE OF USE :
 
     "BEGIN"
         OUTPUT(61,"("/,D.14D")",ARCSINH(SINH(0.01)));
         OUTPUT(61,"("/,D.14D")",ARCSINH(SINH(0.05)));
         OUTPUT(61,"("/,D.14D")",SINH(ARCSINH(0.05)));
         OUTPUT(61,"("/,D.14D")",SINH(ARCSINH(0.01)));
     "END"
 
     DELIVERS :
 
     +0.01000000000000
     +0.05000000000000
     +0.05000000000000
     +0.01000000000000
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 6
 
 
 
 SUBSECTION : ARCCOSH.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" ARCCOSH(X); "VALUE" X; "REAL" X;
     "CODE" 35115;
 
     ARCCOSH : DELIVERS THE INVERSE HYPERBOLIC COSINE OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF ARCCOSH(X), X >= 1.
 
 
 PROCEDURES USED : NONE.
 
 
 METHOD AND PERFORMANCE :
 
     IF X = 1 THE VALUE 0 IS DELIVERED.
     IF 1 < X <= "10 WE USE THE FORMULA :
         ARCCOSH(X) = LN ( X + SQRT ( X * X - 1 ) ).
     IF X > "10 WE USE THE FORMULA :
         ARCCOSH(X) = LN(2) + LN ( X ).
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
     IF X IS CLOSE TO 1, SAY X = 1+Y, Y>0, AND Y IS KNOWN IN GOOD
     RELATIVE PRECISION, THEN IT IS ADVISED TO USE THE PROCEDURE
     LOG ONE PLUS X (SEE SUBSECTION 6.4.3) BY WRITING
     ARCCOSH(X) = LN( 1 + Y + SQRT( Y*(Y+2) ) ).
     EXAMPLE : X = EXP(T), T > 0, T IS SMALL. THEN Y = EXP(T)-1 IS
     AVAILABLE IN GOOD RELATIVE ACCURACY, Y = 2*EXP(T/2)*SINH(T/2).
 
 
 EXAMPLE OF USE :
 
     "BEGIN"
         OUTPUT(61,"("/,D.14D")",ARCCOSH(COSH(0.01)));
         OUTPUT(61,"("/,D.14D")",ARCCOSH(COSH(0.05)));
         OUTPUT(61,"("/,D.14D")",COSH(ARCCOSH(1.01)));
         OUTPUT(61,"("/,D.14D")",COSH(ARCCOSH(1.05)));
     "END"
 
     DELIVERS :
 
     +0.00999999999958
     +0.04999999999999
     +1.01000000000000
     +1.05000000000000
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 7
 
 
 
 SUBSECTION : ARCTANH.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" ARCTANH(X); "VALUE" X; "REAL" X;
     "CODE" 35116;
 
     ARCTANH: DELIVERS THE INVERSE HYPERBOLIC TANGENT OF THE ARGUMENT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF ARCTANH(X).
 
 
 PROCEDURES USED : LOG ONE PLUS X  =  CP 35130,
                   GIANT           =  CP 30004.
 
 
 METHOD AND PERFORMANCE :
 
     IF ABS(X) < 1 WE USE THE PROCEDURE LOG ONE PLUS X (SEE SECTION
         6.4.3) BY WRITING ARCTANH(X) = 0.5 * LN(( 1 + X )/( 1 - X ))=
         0.5 * LN(1+2*X/(1-X)).
     IF ABS(X) = 1 THE VALUE  IS SIGN(X) * GIANT (SEE SECTION 6.2).
     THE VALUES ARE COMPUTED WITH A RELATIVE PRECISION OF ABOUT "-13.
 
 
 EXAMPLE OF USE :
 
     "BEGIN"
         OUTPUT(61,"("/,D.14D")",ARCTANH(TANH(0.01)));
         OUTPUT(61,"("/,D.14D")",ARCTANH(TANH(0.05)));
         OUTPUT(61,"("/,D.14D")",TANH(ARCTANH(0.05)));
         OUTPUT(61,"("/,D.14D")",TANH(ARCTANH(0.01)));
     "END"
 
     DELIVERS :
 
     +0.01000000000000
     +0.05000000000000
     +0.05000000000000
     +0.01000000000000
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 8
 
 
 
 SOURCE TEXTS :
0"CODE" 35111;
  "REAL" "PROCEDURE" SINH(X); "VALUE" X; "REAL" X;
  "BEGIN" "REAL" AX,Y;
     AX:= ABS(X);
     "IF" AX < 0.3 "THEN"
     "BEGIN" Y:= "IF" AX < 0.1 "THEN" X*X "ELSE" X*X/9;
         X:=  ((( 0.0001984540     * Y +
                  0.0083333331783 )* Y +
                  0.16666666666675)* Y +
                  1.0             )* X ;
        SINH:= "IF" AX < 0.1 "THEN" X "ELSE"
               X * ( 1.0 + 0.14814814814815 * X * X )
     "END" "ELSE" "IF" AX < 17.5 "THEN"
     "BEGIN" AX:= EXP( AX ); SINH:= SIGN(X) * .5 * ( AX -1/AX ) "END"
     "ELSE" "IF" AX > 742.36063037970 "THEN"
     "BEGIN"
         SINH:= SIGN(X)*GIANT
     "END" "ELSE"
     SINH:= SIGN(X)*EXP(AX- .69314 71805 59945)
  "END" SINH;
         "EOP"
 
 "CODE" 35112;
  "REAL" "PROCEDURE" COSH(X); "VALUE" X; "REAL" X;
  "IF" ABS(X) < 17.5 "THEN"
  "BEGIN" X:= EXP(X); COSH:= 0.5 * ( X + 1/X ) "END" "ELSE"
  "BEGIN"
      COSH:= SINH(ABS(X))
  "END" COSH;
         "EOP"
 
 "CODE" 35113;
  "REAL" "PROCEDURE" TANH(X); "VALUE" X; "REAL" X;
  "BEGIN" "REAL"AX; AX:= ABS(X);
   "IF" AX < 0.005 "THEN"
   "BEGIN" "REAL" Y; Y:= X*X; TANH:= X * ( 1 - Y *
      (.33333333333333 - Y *
      (.13333333333333 - Y *
       .05396825396825   )))
   "END" "ELSE" "IF" AX < 0.3 "THEN"
   "BEGIN" "REAL" SH;
      SH:= SINH(X);
      TANH:= SH/SQRT(1+SH*SH)
   "END" "ELSE"
   "IF" AX > 17.5 "THEN" TANH:= SIGN(X) "ELSE"
   "BEGIN" AX:= EXP(-2*AX); TANH:= SIGN(X)*(1-AX)/(1+AX) "END"
  "END"
 
1SECTION : 6.4.2              (DECEMBER 1979)                     PAGE 9
 
 
                                                                   ;
         "EOP"
 "CODE" 35114;
  "REAL" "PROCEDURE" ARCSINH(X); "VALUE" X; "REAL" X;
  "IF" ABS(X) > "10 "THEN" ARCSINH:= SIGN(X)*(0.69314 71805 5995+
      LN(ABS(X))) "ELSE"
  "BEGIN" "REAL" Y;
      Y:= X*X; ARCSINH:= SIGN(X)*LOG ONE PLUS X(ABS(X)+Y/(1+SQRT(1+Y)))
  "END" ARCSINH;
         "EOP"
0"CODE" 35115;
  "REAL" "PROCEDURE" ARCCOSH(X); "VALUE" X; "REAL" X;
  ARCCOSH:= "IF" X <= 1 "THEN" 0 "ELSE"
            "IF" X > "10 "THEN" 0.69314718055995 + LN(X) "ELSE"
            LN(X+SQRT((X-1)*(X+1)));
         "EOP"
 
 "CODE" 35116;
  "REAL" "PROCEDURE" ARCTANH(X); "VALUE" X; "REAL" X;
  "IF" ABS(X) >= 1 "THEN"
  "BEGIN"
      ARCTANH:= SIGN(X)*GIANT
  "END" "ELSE"
  "BEGIN" "REAL" AX;
      AX:= ABS(X); ARCTANH:= SIGN(X)*.5*LOG ONE PLUS X(2*AX/(1-AX))
  "END" ARCTANH;
         "EOP"
1SECTION : 6.4.3             (DECEMBER 1978)                     PAGE 1
 
 
 
 AUTHOR : N.M. TEMME.
 
 
 CONTRIBUTOR : R. MONTIJN.
 
 
 INSTITUTE : MATHEMATICAL CENTRE.
 
 
 RECEIVED : 780801.
 
 
 BRIEF DESCRIPTION :
 
     THIS SECTION CONTAINS THE PROCEDURE  LOG ONE PLUS X  FOR
     THE COMPUTATION OF  LN(1+X) FOR X > -1.
 
 
 KEYWORDS : LOGARITHMIC FUNCTION.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" LOG ONE PLUS X(X); "VALUE" X; "REAL" X;
     "CODE" 35130;
     LOG ONE PLUS X : DELIVERS THE VALUE OF LN(1+X);
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC  EXPRESSION>;
             ENTRY :  THE ARGUMENT OF LN(1+X), X > -1.
 
 
 PROCEDURES USED : NONE.
 
 
 RUNNING TIME : THE ALGORITHM NEEDS 9 MULTIPLICATIONS.
 
 
 METHOD AND PERFORMANCE :
 
     FOR  X < -0.2928 OR X > 0.4142  THE PROCEDURE USES
     THE STANDARD FUNCTION LN, FOR -0.2928 <= X <= 0.4142 A
     POLYNOMIAL APPROXIMATION IS USED.
     WE USE AN APPROXIMATION BASED ON THE BEST APPROXIMATON FOR
     THE INTERVAL 1/SQRT(2)-1 <= X <= SQRT(2)-1, OF WHICH THE
     COEFFICIENTS ARE GIVEN IN HART (1968); CF. P. 111, INDEX 2665.
     THE PROCEDURE LOG ONE PLUS X COMPUTES LN(1+X) WITH RELATIVE
     ACCURACY COMPARABLE WITH THE MACHINE ACCURACY.
1SECTION : 6.4.3             (DECEMBER 1978)                     PAGE 2
 
 
 
     AS IS WELL KNOWN, FOR SMALL ABS(X) RELATIVE ACCURACY IS LOST
     WHEN COMPUTING LN(1+X) BY USING THE STANDARD FUNCTION LN.
     THE PROCEDURE IS USED IN THE PROCEDURES ARCSINH AND ARCTANH,
     SECTION 6.4.2.
 
 
 REFERENCES : HART, J.F. CS. (1968), COMPUTER APPROXIMATIONS,
              WILEY, NEW YORK.
 
 
 EXAMPLE OF USE :
 
     WE COMPUTE LN(EXP(X)) FOR SMALL POSITIVE X. IN ORDER TO
     PRESERVE RELATIVE ACCURACY WE WRITE
 
     LN ( EXP(X) )   =    LN ( 1+ EXP(X)-1 )
                     =    LN ( 1+ 2* EXP(X/2)* SINH(X/2) ).
 
     THE FOLOWING PROGRAM
 
     "BEGIN" "REAL" X,Y;
         "FOR" X:= "-1, "-10, "-50, "-100, "-250 "DO"
         "BEGIN" Y:= LOG ONE PLUS X( 2*EXP(X/2)*SINH(X/2) );
             OUTPUT(61,"("N,/")",Y)
         "END"
     "END"
 
     PRINTS THE FOLOWING RESULTS :
 
     +1.0000000000000"-001
     +1.0000000000000"-010
     +1.0000000000000"-050
     +1.0000000000000"-100
     +1.0000000000000"-250
 
 
 SOURCE TEXT :
 "CODE" 35130;
 "REAL" "PROCEDURE" LOG ONE PLUS X(X); "VALUE" X; "REAL" X;
 "COMMENT" COMPUTES LN(1+X) FOR X > -1;
 "IF" X = 0 "THEN" LOG ONE PLUS X:= 0 "ELSE"
 "IF" X < -0.2928 "OR" X > 0.4142 "THEN" LOG ONE PLUS X:= LN(1+X) "ELSE"
 "BEGIN" "REAL" Y,Z;
     Z:= X/(X+2); Y:= Z*Z;
     LOG ONE PLUS X:= Z*(2+ Y*
     ( .66666 66666 63366 + Y*
     ( .40000 00012 06045 + Y*
     ( .28571 40915 90488 + Y*
     ( .22223 82333 2791  + Y*
     ( .18111 36267 967   + Y*
       .16948 21248 8))))))
 "END" LOG ONE PLUS X;
        "EOP"
1SECTION : 6.5.1              (DECEMBER 1979)                     PAGE 1
 
 
 
 AUTHOR(S) : H.FIOLET, N.TEMME.
 
 
 INSTITUTE : MATHEMATICAL CENTRE.
 
 
 RECEIVED: 740628.
 
 
 BRIEF DESCRIPTION :
 
     THIS SECTION CONTAINS FOUR PROCEDURES :
 
     A.
     EI  CALCULATES  THE  EXPONENTIAL INTEGRAL DEFINED  AS  FOLLOWS (SEE
     ALSO  REF[1] , EQ. (5.1.1))   : EI(X) = INTEGRAL (EXP(T)/T DT) FROM
     T=-INFINITY TO T=X , WHERE THE INTEGRAL IS TO BE INTERPRETED AS THE
     CAUCHY PRINCIPAL VALUE. ALSO THE RELATED FUNCTION E1(X), DEFINED BY
     THE INTEGRAL (EXP(-T)/T DT) FROM T= X TO T= INFINITY, FOR POSITIVE
     X (REF[1], EQ.(5.1.2)) CAN EASILY BE OBTAINED BY THE RELATION
     E1(X) = - EI(-X).  FOR X=0 THE INTEGRAL IS UNDEFINED AND THE
     PROCEDURE WILL CAUSE OVERFLOW.
 
     B.
     EIALPHA CALCULATES A SEQUENCE OF INTEGRALS OF THE FORM
       INTEGRAL( EXP(-X*T)*T**I DT )
     FROM T=1 TO T= INFINITY,
     WHERE X IS POSITIVE  AND I = 0,...,N.
     (SEE ALSO REF[1], EQ. (5.1.5)).
 
     C.
     ENX COMPUTES  A SEQUENCE OF  INTEGRALS   E(N,X),
     N=N1, N1+1,...,N2, WHERE  X>0 AND N1, N2 ARE POSITIVE INTEGERS WITH
     N2>=N1; E(N,X) IS DEFINED AS FOLLOWS:
        E(N,X)= THE INTEGRAL FROM 1 TO INFINITY OF EXP(-X * T)/ T**N DT;
     (SEE ALSO REF[1], EQ.(5.1.4));
 
     D.
     NONEXPENX  COMPUTES  A  SEQUENCE   OF  INTEGRALS
     EXP(X)*E(N,X), N=N1, N1+1,...,N2, WHERE X>0 AND N1, N2 ARE POSITIVE
     INTEGERS WITH N2>=N1; E(N,X) IS DEFINED UNDER C).
 
 
 KEYWORDS :
 
     EXPONENTIAL INTEGRAL,
     SPECIAL FUNCTIONS.
 
 
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 2
 
 
 
 SUBSECTION : EI.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" EI(X);
     "VALUE" X;"REAL" X;
     "CODE" 35080;
 
     EI:     DELIVERS THE VALUE OF THE EXPONENTIAL INTEGRAL;
 
     THE MEANING OF THE FORMAL PARAMETER IS :
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT OF THE INTEGRAL.
 
 
 PROCEDURES USED :
 
     CHEPOLSUM = CP31046 ,
     POL       = CP31040 ,
     JFRAC     = CP35083 .
 
 
 LANGUAGE : ALGOL 60.
 
 
 METHOD AND PERFORMANCE :
 
     THE  INTEGRAL  IS  CALCULATED  BY  MEANS  OF THE RATIONAL CHEBYSHEV
     APPROXIMATIONS  GIVEN  IN  REFERENCES [1] AND [2]. ONLY  RATIOS  OF
     POLYNOMIALS WITH EQUAL DEGREE L ARE CONSIDERED. BELOW,THE DIFFERENT
     INTERVALS ARE LISTED, TOGETHER WITH THE CORRESPONDING DEGREE L  AND
     THE NUMBER OF CORRECT DIGITS OF THE APPROXIMATIONS :
         [-INFINITY,-4]   6   15.1
         [-4,-1]          7   16.9
         [-1, 0]          5   18.5
         [ 0, 6]          7   15.2
         [ 6,12]          7   15.1
         [12,24]          7   15.0
         [24,+INFINITY]   7   15.9  .
     VARIOUS  TESTS  SHOWED A RELATIVE ACCURACY OF AT LEAST "-13,  EXEPT
     IN THE NEIGHBOURHOOD OF X=.37250 , THE ZERO OF THE INTEGRAL,  WHERE
     ONLY  AN  ABSOLUTE  ACCURACY OF .3"-13  IS REACHED . IN SOME OF THE
     INTERVALS , THE RATIONAL  FUNCTIONS ARE EXPRESSED  EITHER AS RATIOS
     OF FINITE SUMS OF CHEBYSHEV  POLYNOMIALS OR AS J-FRACTIONS, SINCE
     THE ORIGINAL FORMS ARE POORLY CONDITIONED.
 
 
 REFERENCES : SEE REFERENCES [1], [2] AND [3] OF THE PROCEDURE
              NONEXPENX (THIS SECTION).
 
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 3
 
 
 
 EXAMPLE OF USE :
 
     "BEGIN"
         "COMMENT" THE COMPUTATION OF E1(.5);
         OUTPUT(61,"("N")",-EI(-.5))
     "END"
 
     DELIVERS :
     +5.5977359477616"-001         .
 
 
 SUBSECTION : EIALPHA.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" EIALPHA(X,N,ALPHA);
     "VALUE" N,X;"INTEGER" N;"REAL" X;"ARRAY" ALPHA;
     "CODE" 35081;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             THE REAL X OCCURING IN THE INTEGRAND.
     N:      <ARITHMETIC EXPRESSION>;
             UPPER BOUND FOR THE INTEGER I OCCURING IN THE INTEGRAND;
     ALPHA:  <ARRAY IDENTIFIER>;
             "ARRAY" ALPHA[0:N];
             THE  VALUE OF THE INTEGRAL(EXP(-X*T)*T**I DT) FROM  T=1  TO
             T=INFINITY IS STORED IN ALPHA[I].
 
 
 PROCEDURES USED : NONE.
 
 
 RUNNING TIME : CIRCA ( 6 + N * .8 ) * "-4 SEC.
 
 
 LANGUAGE : ALGOL 60.
 
 
 METHOD AND PERFORMANCE :
     THE  INTEGRAL  IS  CALCULATED  BY  MEANS OF  THE  RECURSION FORMULA
     A[N]:=A[0] + N * A[N-1] / X, WITH A[0]:= EXP(-X)/X. FOR X CLOSE  TO
     ZERO, EIALPHA MIGHT CAUSE OVERFLOW, SINCE THE VALUE OF THE INTEGRAL
     IS INFINITE FOR X=0. THE PROCEDURE IS NOT PROTECTED AGAINST THIS
     TYPE OF OVERFLOW. THE MINIMAL VALUE FOR THE ARGUMENT X DEPENDS ON
     THE PARAMETER N :
     N=20    X CIRCA "-14
     N=15    X CIRCA "-18
     N=10    X CIRCA "-28
     N= 5    X CIRCA "-53
     THE RECURSION FORMULA IS STABLE AND VARIOUS TESTS EXECUTED ON THE
     CD CYBER 7228 SHOWED A RELATIVE ACCURACY OF AT LEAST .2"-12.
 
 
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 4
 
 
 
 EXAMPLE OF USE :
 
     "BEGIN"
         "INTEGER" K;"REAL" "ARRAY" A[0:5];
         EIALPHA(.25,5,A);
         "FOR" K:=0 "STEP" 1 "UNTIL" 5 "DO"
         OUTPUT(61,"("DBBB,N,/")",K,A[K]);
     "END"
 
     DELIVERS :
     0   +3.1152031322856"+000
     1   +1.5576015661428"+001
     2   +1.2772332842371"+002
     3   +1.5357951442168"+003
     4   +2.4575837510601"+004
     5   +4.9151986541516"+005   .
 
 
 REFERENCES: SEE REFERENCE [1] OF THE PROCEDURE NONEXPENX(THIS SECTION).
 
 
 SUBSECTION: ENX.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" ENX(X, N1, N2, A);
     "VALUE" X, N1, N2; "REAL" X; "INTEGER" N1, N2; "ARRAY" A;
     "CODE" 35086;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X :     <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) POSITIVE X OCCURING IN THE INTEGRAND;
     N1, N2: <ARITHMETIC EXPRESSION>;
             ENTRY: LOWER AND UPPER BOUND, RESPECTIVELY, OF THE  INTEGER
                    N OCCURING IN THE INTEGRAND;
     A:      <ARRAY IDENTIFIER>;
             "ARRAY" A[N1:N2];
             EXIT:  THE VALUE OF THE INTEGRAL(EXP(-X * T)/T**I DT)  FROM
                    T=1 TO T= INFINITY IS STORED IN A[I].
 
 PROCEDURES USED:
     EI        = CP35080,
     NONEXPENX = CP35087.
 
 RUNNING TIME:
     DEPENDS STRONGLY ON THE VALUES OF X, N1, AND N2, WITH A MAXIMUM
     OF ROUGHLY  ( 5 + .1 * NUMBER OF NECESSARY ITERATIONS ) MSEC.
 
 LANGUAGE: ALGOL 60.
 
 METHOD AND PERFORMANCE:
     SEE METHOD AND PERFORMANCE OF THE PROCEDURE NONEXPENX(THIS SECTION)
 
 
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 5
 
 
 
 SUBSECTION: NONEXPENX.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" NONEXPENX(X, N1, N2, A);
     "VALUE" X, N1, N2; "REAL" X; "INTEGER" N1, N2; "ARRAY" A;
     "CODE" 35087;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) POSITIVE X OCCURING IN THE INTEGRAND;
     N1, N2: <ARITHMETIC EXPRESSION>;
             ENTRY: LOWER  AND UPPER BOUND, RESPECTIVELY, OF THE INTEGER
                    I OCCURING IN THE INTEGRAND;
     A:      <ARRAY IDENTIFIER>;
             "ARRAY" A[N1:N2];
             EXIT:  THE  VALUE  OF  EXP(X) * INTEGRAL(EXP(-X*T)/T**I DT)
                    FROM T=1 TO T=INFINITY IS STORED IN A[I].
 
 
 PROCEDURES USED:
     ENX = CP35086.
 
 
 RUNNING TIME:
     DEPENDS STRONGLY ON THE VALUES OF X, N1, AND N2, WITH A MAXIMUM
     OF ROUGHLY    ( 5 + .1 * NUMBER OF NECESSARY ITERATIONS) MSEC.
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
     THE SEQUENCE OF INTEGRALS IS GENERATED BY MEANS  OF THE  RECURRENCE
     RELATION:
           E(N+1,X) = (EXP(-X) - X * E(N,X))/N.
     FOR REASONS OF STABILITY THE RECURSION STARTS  WITH  E(N0,X), WHERE
     N0=ENTIER(X+.5), (SEE ALSO REF[5]). THE INTEGRALS ARE THEN COMPUTED
     BY BACKWARD RECURRENCE IF N<N0 AND BY FORWARD  RECURRENCE IF  N>N0.
     TO  OBTAIN   THE  STARTING  VALUES   E(N0,X) OF  THE RECURSION  THE
     FOLLOWING CASES ARE DISTINGUISHED:
     A) N0 = 1: THE PROCEDURE EI IS USED (THIS SECTION);
     B) N0<=10: A TAYLOR  EXPANSION   ABOUT  X=N0 IS USED, WHICH MADE IT
                NECESSARY TO STORE THE VALUES OF E(N,N) IN THE PROCEDURE
                FOR N= 2, 3,...,10;
     C) N0 >10: THE FOLLOWING CONTINUED FRACTION IS USED:
                EXP(X)*E(N,X) = 1/(X+N/(1+1/(X+(N+1)/(1+...)))),
                (SEE ALSO REF[4], EQ.(2.3));
     THE CASES A) AND B) ARE TREATED IN ENX, WHILE  NONEXPENX  EVALUATES
     THE CONTINUED FRACTION IN CASE C).
     ENX CALLS FOR NONEXPENX IN CASE C).
     NONEXPENX CALLS FOR ENX IN THE CASES A) AND B).
     VARIOUS TESTS SHOWED A RELATIVE ACCURACY OF AT LEAST 5"-14.
 
 
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 6
 
 
 
 REFERENCES:
 
     [1].M.ABRAMOWITZ AND I.A.STEGUN.
         HANDBOOK OF MATHEMATICAL FUNCTIONS.
         DOVER PUBLICATIONS, INC. NEW YORK (1965).
 
     [2] W.J.CODY AND H.C.THACHER, JR.
         RATIONAL CHEBYSHEV APPROXIMATIONS FOR THE EXPONENTIAL INTEGRAL
         E1(X).
         MATH. COMP. 22 (JULY 1968), 641-649.
 
     [3] W.J.CODY AND H.C.THACHER, JR.
         CHEBYSHEV APPROXIMATIONS FOR THE EXPONENTIAL INTEGRAL EI(X).
         MATH. COMP. 23 (APRIL 1969), 289-303.
 
     [4].W.GAUTSCHI.
         EXPONENTIAL INTEGRALS.
         CACM, DECEMBER 1973, P.761-763.
 
     [5].W.GAUTSCHI.
         RECURSIVE COMPUTATION OF CERTAIN INTEGRALS.
         JACM, VOL.8, 1961, P.21-40.
 
 
 EXAMPLE OF USE:
 
     IN THE FOLLOWING PROGRAM  WE COMPUTE THE VALUES OF
     E(40,1.1), E(41,1.1), E(42,1.1) AND EXP(X)*E(1,50.1).
 
     "BEGIN"
 
         "INTEGER" I;
         "REAL" "ARRAY" A[40:42], B[1:1];
 
         ENX(1.1, 40, 42, A);
         "FOR" I:= 40, 41, 42 "DO"
         OUTPUT(61,"("4B,"("E(")",DD,"(",1.1)=  ")",N/")",I,A[I]);
         NONEXPENX(50.1, 1, 1, B);
         OUTPUT(61,"("/,4B,"("EXP(50.1)*E(1,50.1)=  ")",N")",B[1]);
     "END"
 
     THIS PROGRAM DELIVERS:
 
     E(40,1.1)=  +8.2952134128634"-003
     E(41,1.1)=  +8.0936587235982"-003
     E(42,1.1)=  +7.9016599781006"-003
 
     EXP(50.1)*E(1,50.1)=  +1.9576696324723"-002
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 7
 
 
 
 SOURCE TEXT(S):
0"CODE" 35080;
 "REAL" "PROCEDURE" EI(X);"VALUE" X;"REAL" X;
 "BEGIN" "REAL" "ARRAY" P,Q[0:7];
 
     "IF" X>24 "THEN"
     "BEGIN" P[0]:= +1.00000000000058   ;Q[1]:= 1.99999999924131   ;
             P[1]:=X-3.00000016782085   ;Q[2]:=-2.99996432944446   ;
             P[2]:=X-5.00140345515924   ;Q[3]:=-7.90404992298926   ;
             P[3]:=X-7.49289167792884   ;Q[4]:=-4.31325836146628   ;
             P[4]:=X-3.08336269051763"+1;Q[5]:= 2.95999399486831"+2;
             P[5]:=X-1.39381360364405   ;Q[6]:=-6.74704580465832   ;
             P[6]:=X+8.91263822573708   ;Q[7]:= 1.04745362652468"+3;
             P[7]:=X-5.31686623494482"+1;
        EI:=EXP(X)*(1+JFRAC(7,Q,P)/X)/X
     "END" "ELSE" "IF" X>12 "THEN"
     "BEGIN" P[0]:= +9.99994296074708"-1;Q[1]:= 1.00083867402639   ;
             P[1]:=X-1.95022321289660   ;Q[2]:=-3.43942266899870   ;
             P[2]:=X+1.75656315469614   ;Q[3]:= 2.89516727925135"+1;
             P[3]:=X+1.79601688769252"+1;Q[4]:= 7.60761148007735"+2;
             P[4]:=X-3.23467330305403"+1;Q[5]:= 2.57776384238440"+1;
             P[5]:=X-8.28561994140641   ;Q[6]:= 5.72837193837324"+1;
             P[6]:=X-1.86545454883399"+1;Q[7]:= 6.95000655887434"+1;
             P[7]:=X-3.48334653602853   ;
        EI:=EXP(X)*JFRAC(7,Q,P)/X
     "END" "ELSE" "IF" X>6 "THEN"
     "BEGIN" P[0]:= +1.00443109228078   ;Q[1]:= 5.27468851962908"-1;
             P[1]:=X-4.32531132878135"+1;Q[2]:= 2.73624119889328"+3;
             P[2]:=X+6.01217990830080"+1;Q[3]:= 1.43256738121938"+1;
             P[3]:=X-3.31842531997221"+1;Q[4]:= 1.00367439516726"+3;
             P[4]:=X+2.50762811293560"+1;Q[5]:=-6.25041161671876   ;
             P[5]:=X+9.30816385662165   ;Q[6]:= 3.00892648372915"+2;
             P[6]:=X-2.19010233854880"+1;Q[7]:= 3.93707701852715  ;
             P[7]:=X-2.18086381520724   ;
        EI:=EXP(X)*JFRAC(7,Q,P)/X
     "END" "ELSE" "IF" X>0 "THEN"
     "BEGIN" "REAL" T,R,X0,XMX0;
             P[0]:=-1.95773036904548"+8;Q[0]:=-8.26271498626055"+7;
             P[1]:= 3.89280421311201"+6;Q[1]:= 8.91925767575612"+7;
             P[2]:=-2.21744627758845"+7;Q[2]:=-2.49033375740540"+7;
             P[3]:=-1.19623669349247"+5;Q[3]:= 4.28559624611749"+6;
             P[4]:=-2.49301393458648"+5;Q[4]:=-4.83547436162164"+5;
             P[5]:=-4.21001615357070"+3;Q[5]:= 3.57300298058508"+4;
             P[6]:=-5.49142265521085"+2;Q[6]:=-1.60708926587221"+3;
             P[7]:=-8.66937339951070   ;Q[7]:= 3.41718750000000"+1;
        X0:=.372507410781367;
        T:=X/3-1;
        R:=CHEPOLSUM(7,T,P)/CHEPOLSUM(7,T,Q);
        XMX0:=(X-409576229586/1099511627776)-.767177250199394"-12;
                                                               "COMMENT"
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 8
                                                                  ;
 
 
        "IF" ABS(XMX0)>.037 "THEN" T:=LN(X/X0) "ELSE"
        "BEGIN" "REAL" Z,Z2;
             P[0]:= .837207933976075"+1;Q[0]:= .418603966988037"+1;
             P[1]:=-.652268740837103"+1;Q[1]:=-.465669026080814"+1;
             P[2]:= .569955700306720   ;Q[2]:= .1"+1;
            Z:=XMX0/(X+X0);Z2:=Z*Z;
            T:=Z*POL(2,Z2,P)/POL(2,Z2,Q)
        "END";
        EI:=T+XMX0*R
     "END" "ELSE"
     "IF" X>-1 "THEN"
     "BEGIN" "REAL" Y;
             P[0]:=-4.41785471728217"+4;Q[0]:= 7.65373323337614"+4;
             P[1]:= 5.77217247139444"+4;Q[1]:= 3.25971881290275"+4;
             P[2]:= 9.93831388962037"+3;Q[2]:= 6.10610794245759"+3;
             P[3]:= 1.84211088668000"+3;Q[3]:= 6.35419418378382"+2;
             P[4]:= 1.01093806161906"+2;Q[4]:= 3.72298352833327"+1;
             P[5]:= 5.03416184097568   ;Q[5]:= 1;
        Y:=-X;
        EI:=LN(Y)-POL(5,Y,P)/POL(5,Y,Q)
     "END" "ELSE" "IF" X>-4 "THEN"
     "BEGIN" "REAL" Y;
             P[0]:= 8.67745954838444"-8;Q[0]:= 1;
             P[1]:= 9.99995519301390"-1;Q[1]:= 1.28481935379157"+1;
             P[2]:= 1.18483105554946"+1;Q[2]:= 5.64433569561803"+1;
             P[3]:= 4.55930644253390"+1;Q[3]:= 1.06645183769914"+2;
             P[4]:= 6.99279451291003"+1;Q[4]:= 8.97311097125290"+1;
             P[5]:= 4.25202034768841"+1;Q[5]:= 3.14971849170441"+1;
             P[6]:= 8.83671808803844   ;Q[6]:= 3.79559003762122   ;
             P[7]:= 4.01377664940665"-1;Q[7]:= 9.08804569188869"-2;
        Y:=-1/X;
        EI:=-EXP(X)*POL(7,Y,P)/POL(7,Y,Q)
     "END" "ELSE"
     "BEGIN" "REAL" Y;
             P[0]:=-9.99999999998447"-1;Q[0]:= 1;
             P[1]:=-2.66271060431811"+1;Q[1]:= 2.86271060422192"+1;
             P[2]:=-2.41055827097015"+2;Q[2]:= 2.92310039388533"+2;
             P[3]:=-8.95927957772937"+2;Q[3]:= 1.33278537748257"+3;
             P[4]:=-1.29885688746484"+3;Q[4]:= 2.77761949509163"+3;
             P[5]:=-5.45374158883133"+2;Q[5]:= 2.40401713225909"+3;
             P[6]:=-5.66575206533869   ;Q[6]:= 6.31657483280800"+2;
        Y:=-1/X;
        EI:=-EXP(X)*Y*(1+Y*POL(6,Y,P)/POL(6,Y,Q))
     "END"
 "END" EI
1SECTION : 6.5.1              (SEPTEMBER 1974)                    PAGE 9
 
 
                                                                   ;
         "EOP"
 "CODE" 35081;
     "PROCEDURE" EIALPHA(X,N,ALPHA);
     "VALUE" X,N;"REAL" X;"INTEGER" N;"ARRAY" ALPHA;
     "BEGIN" "REAL" A,B,C;"INTEGER" K;
         C:=1/X;A:=EXP(-X);
         B:=ALPHA[0]:=A*C;
         "FOR" K:=1 "STEP" 1 "UNTIL" N "DO"
         ALPHA[K]:=B:=(A+K*B)*C
     "END" EIALPHA;
         "EOP"
0"CODE" 35086;
     "PROCEDURE" ENX(X, N1, N2, A);
     "VALUE" X, N1, N2;
     "REAL" X; "INTEGER" N1, N2; "ARRAY" A;
     "IF" X<= 1.5 "THEN"
     "BEGIN"
         "REAL" W, E; "INTEGER" I;
         W:= -EI(-X);
         "IF" N1=1 "THEN" A[1]:=W;
         "IF" N2>1 "THEN" E:= EXP(-X);
         "FOR" I:=2 "STEP" 1 "UNTIL" N2 "DO"
         "BEGIN"
             W:= (E - X * W)/(I - 1);
             "IF" I>= N1 "THEN" A[I]:=W
         "END"
     "END" "ELSE"
     "BEGIN" "INTEGER" I, N; "REAL" W, E, AN;
         N:=ENTIER(X+.5);
         "IF" N<=10 "THEN"
         "BEGIN" "REAL" F, W1, T, H;
             "REAL" "ARRAY" P[2:19];
             P[ 2]:=.37534261820491"-1; P[11]:=.135335283236613   ;
             P[ 3]:=.89306465560228"-2; P[12]:=.497870683678639"-1;
             P[ 4]:=.24233983686581"-2; P[13]:=.183156388887342"-1;
             P[ 5]:=.70576069342458"-3; P[14]:=.673794699908547"-2;
             P[ 6]:=.21480277819013"-3; P[15]:=.247875217666636"-2;
             P[ 7]:=.67375807781018"-4; P[16]:=.911881965554516"-3;
             P[ 8]:=.21600730159975"-4; P[17]:=.335462627902512"-3;
             P[ 9]:=.70411579854292"-5; P[18]:=.123409804086680"-3;
             P[10]:=.23253026570282"-5; P[19]:=.453999297624848"-4;
                                                               "COMMENT"
1SECTION : 6.5.1              (SEPTEMBER 1974)                   PAGE 10
                                                                 ;
 
 
             F:= W:= P[N];
             E:= P[N+9];
             W1:= T:= 1;
             H:= X-N;
             "FOR" I:=N-1, I-1 "WHILE" ABS(W1)>"-15 * W "DO"
             "BEGIN"
                 F:= (E - I * F)/N;
                 T:= -H * T / (N-I);
                 W1:= T * F; W:= W + W1
              "END"
         "END" "ELSE"
         "BEGIN"
             "ARRAY" B[N:N];
             NONEXPENX(X, N, N, B);
             W:= B[N] * EXP(-X)
         "END";
         "IF" N1=N2 & N1=N "THEN" A[N]:=W "ELSE"
         "BEGIN"
             E:= EXP(-X);
             AN:=W;
             "IF" N<=N2 & N>=N1 "THEN" A[N]:=W;
             "FOR" I:= N-1 "STEP" -1 "UNTIL" N1 "DO"
             "BEGIN"
                 W:= (E - I * W)/X;
                 "IF" I<= N2 "THEN" A[I]:= W
             "END";
             W:=AN;
             "FOR" I:=N+1 "STEP" 1 "UNTIL" N2 "DO"
             "BEGIN"
                 W:= (E - X * W)/(I - 1);
                 "IF" I>=N1 "THEN" A[I]:=W
             "END"
         "END"
     "END" ENX
1SECTION : 6.5.1              (SEPTEMBER 1974)                   PAGE 11
 
                                                                  ;
         "EOP"
0"CODE" 35087;
     "PROCEDURE" NONEXPENX(X, N1, N2, A);
     "VALUE" X, N1, N2;
     "REAL" X; "INTEGER" N1, N2; "ARRAY" A;
     "BEGIN" "INTEGER" I, N; "REAL" W, AN;
         N:= "IF" X<=1.5 "THEN" 1 "ELSE" ENTIER(X+.5);
         "IF" N<=10 "THEN"
         "BEGIN"
             "ARRAY" B[N:N];
             ENX(X, N, N, B);
             W:= B[N] * EXP(X)
         "END" "ELSE"
         "BEGIN"
             "INTEGER" K, K1;
             "REAL" UE, VE, WE, WE1, UO, VO, WO, WO1, R, S;
             UE:=1; VE:= WE:= 1/(X+N); WE1:=0;
             UO:=1; VO:= -N/(X * (X + N + 1)); WO1:= 1/X; WO:= VO + WO1;
             W:= (WE + WO)/2;
             K1:=1;
             "FOR" K:=K1 "WHILE" WO-WE>"-15 * W & WE>WE1 & WO<WO1 "DO"
             "BEGIN"
                 WE1:= WE; WO1:=WO;
                 R:= N+K; S:= R + X + K;
                 UE:= 1/(1-K*(R-1)*UE/((S-2)*S));
                 UO:= 1/(1-K*  R  *UO/( S * S-1));
                 VE:= VE * (UE-1);
                 VO:= VO * (UO-1);
                 WE:= WE + VE;
                 WO:= WO + VO;
                 W:= (WE + WO)/2;
                 K1:= K1 + 1
             "END"
         "END";
         AN:=W;
         "IF" N<=N2 & N>=N1 "THEN" A[N]:=W;
         "FOR" I:= N-1 "STEP" -1 "UNTIL" N1 "DO"
         "BEGIN"
             W:= (1 - I * W)/X;
             "IF" I<= N2 "THEN" A[I]:=W
         "END";
         W:=AN;
         "FOR" I:= N+1 "STEP" 1 "UNTIL" N2 "DO"
         "BEGIN"
             W:= (1 - X * W)/(I - 1);
             "IF" I>=N1 "THEN" A[I]:=W
         "END"
     "END" EXPENX;
         "EOP"
1SECTION : 6.5.2              (MARCH 1977)                        PAGE 1
 
 
 
 AUTHOR(S): H.FIOLET, N.TEMME.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 740317.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS TWO PROCEDURES:
 
     THE PROCEDURE SINCOSINT CALCULATES THE  SINE INTEGRAL  SI(X) AND
     THE COSINE INTEGRAL CI(X) DEFINED BY
         SI(X) = INTEGRAL FROM 0 TO X OF  SIN(T)/T DT
     AND
         CI(X) = GAMMA + LN(ABS(X)) +
                 INTEGRAL FROM 0 TO X OF (COS(T)-1)/T DT,
     WHERE GAMMA DENOTES EULER'S CONSTANT
     (SEE [1] EQ. 5.2.1 AND 5.2.2);
 
     THE AUXILIARY PROCEDURE SINCOSFG CALCULATES F(X) AND G(X)
     DEFINED BY
         F(X) = CI(X) * SIN(X) - (SI(X) - PI / 2) * COS(X)
     AND
         G(X) =-CI(X) * COS(X) - (SI(X) - PI / 2) * SIN(X);
 
     FOR X=0 THE VALUES OF CI(X), F(X) AND G(X) ARE UNDEFINED;
     THE FOLLOWING RELATIONS CONCERNING NEGATIVE X ARE VALID:
     SI(-X) = -SI(X), CI(-X) = CI(X), F(-X) = -F(X), G(-X) = G(X).
 
 
 KEYWORDS: SINE INTEGRAL,
           COSINE INTEGRAL.
 
 
 SUBSECTION: SINCOSINT.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" SINCOSINT(X,SI,CI); "VALUE" X; "REAL" X, SI, CI;
     "CODE" 35084;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X :     <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF SI(X) AND CI(X);
     SI:     <VARIABLE>;
             EXIT: THE VALUE OF SI(X);
     CI:     <VARIABLE>;
             EXIT: THE VALUE OF CI(X).
 
 
1SECTION : 6.5.2              (SEPTEMBER 1974)                    PAGE 2
 
 
 
 PROCEDURES USED:
 
     SINCOSFG  = CP35385,
     CHEPOLSUM = CP31046.
 
 
 RUNNING TIME:
 
     "IF" ABS(X) <= 4 "THEN" ABOUT 3.8 MSEC
                      "ELSE" ABOUT 7.5 MSEC .
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
 
     SEE METHOD AND PERFORMANCE OF THE PROCEDURE SINCOSFG
     (THIS SECTION).
 
 
 SUBSECTION: SINCOSFG.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" SINCOSFG(X,F,G); "VALUE" X; "REAL" X, F, G;
     "CODE" 35085;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF F(X) AND G(X);
     F:      <VARIABLE>;
             EXIT: THE VALUE OF F(X);
     G:      <VARIABLE>;
             EXIT: THE VALUE OF G(X).
 
 
 PROCEDURES USED:
 
     SINCOSINT = CP35084,
     CHEPOLSUM = CP31046.
 
 
 RUNNING TIME:
 
     "IF" ABS(X) <= 4 "THEN" ABOUT 4.7 MSEC
                      "ELSE" ABOUT 6.5 MSEC .
 
 
 LANGUAGE: ALGOL 60.
 
 
1SECTION : 6.5.2              (MARCH 1977)                        PAGE 3
 
 
 
 METHOD AND PERFORMANCE:
 
     IF ABS(X) <= 4  THE  SINE AND COSINE INTEGRALS  ARE  REPRESENTED BY
     TRUNCATED CHEBYSHEV SERIES. ON THIS INTERVAL THE FUNCTIONS F AND  G
     ARE   CALCULATED  BY MEANS OF  THE  EQUATIONS  GIVEN IN  THE  BRIEF
     DESCRIPTION.
     IF ABS(X) > 4  THE FUNCTIONS F AND G  ARE  REPRESENTED BY TRUNCATED
     CHEBYSHEV SERIES. IN THIS  CASE  THE  SINE AND COSINE INTEGRALS ARE
     COMPUTED BY MEANS OF THE FOLLOWING RELATIONS:
         SI(X) = PI / 2 - F(X) * COS(X) - G(X) * SIN(X)
     AND
         CI(X) =          F(X) * SIN(X) - G(X) * COS(X).
     THE FUNCTION  VALUES  ARE COMPUTED  WITH A  RELATIVE  PRECISION  OF
     ABOUT "-13.
     WHEN USING THE PROCEDURE SINCOSINT FOR LARGE VALUES OF X , THE
     RELATIVE  ACCURACY MAINLY DEPENDS ON THE ACCURACY OF THE  FUNCTIONS
     SIN(X) AND COS(X).
 
 
 REFERENCES:
 
     [1].M.ABRAMOWITZ AND I.STEGUN (EDS.),1964.
         HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND
         MATHEMATICAL TABLES.
         APPL. MATH. SER. 55, U.S.GOVT. PRINTING OFFICE,WASHINGTON, D.C.
 
     [2].R.BULIRSCH.
         NUMERICAL CALCULATION OF THE SINE, COSINE AND FRESNEL INTEGRALS
         HANDBOOK SERIES SPECIAL FUNCTIONS.
         NUM. MATH. 9, 1967, PP380-385.
 
 
 EXAMPLE OF USE:
 
     IN THE FOLLOWING PROGRAM  WE COMPUTE THE VALUES OF SI(X), CI(X),
     F(X) AND G(X) FOR X = 1;
 
     "BEGIN"
 
         "REAL" SI, CI, F, G;
 
         SINCOSINT(1, SI, CI);
         SINCOSFG(1, F, G);
 
         OUTPUT(61,"("4B,"("SI(1)= ")",N,2B,"("CI(1)= ")",N/")",SI,CI);
         OUTPUT(61,"("4B,"(" F(1)= ")",N,2B,"(" G(1)= ")",N ")", F, G);
     "END"
 
     THIS PROGRAM DELIVERS:
 
     SI(1)=  +9.46083070367166"-001   CI(1)=  +3.37403922900972"-001
      F(1)=  +6.21449624235829"-001    G(1)=  +3.43377961556442"-001
1SECTION : 6.5.2              (MARCH 1977)                        PAGE 4
 
 
 
 SOURCE TEXT(S):
0"CODE" 35084;
     "PROCEDURE" SINCOSINT(X,SI,CI); "VALUE" X; "REAL" X,SI,CI;
     "BEGIN" "REAL" ABSX,Z,F,G;
 
         ABSX:= ABS(X);
         "IF" ABSX <= 4 "THEN"
         "BEGIN" "REAL" "ARRAY" A[0:10]; "REAL" Z2;
             A[0] :=+2.7368706803630"+00; A[1]:=-1.1106314107894"+00;
             A[2] :=+1.4176562194666"-01; A[3]:=-1.0252652579174"-02;
             A[4] :=+4.6494615619880"-04; A[5]:=-1.4361730896642"-05;
             A[6] :=+3.2093684948229"-07; A[7]:=-5.4251990770162"-09;
             A[8] :=+7.1776288639895"-11; A[9]:=-7.6335493723482"-13;
             A[10]:=+6.6679958346983"-15;
             Z:= X / 4; Z2:= Z * Z; G:= Z2 +Z2 - 1;
             SI:= Z * CHEPOLSUM(10,G,A);
             A[0] :=+2.9659601400727"+00; A[1]:=-9.4297198341830"-01;
             A[2] :=+8.6110342738169"-02; A[3]:=-4.7776084547139"-03;
             A[4] :=+1.7529161205146"-04; A[5]:=-4.5448727803752"-06;
             A[6] :=+8.7515839180060"-08; A[7]:=-1.2998699938109"-09;
             A[8] :=+1.5338974898831"-11; A[9]:=-1.4724256070277"-13;
             A[10]:=+1.1721420798429"-15;
             CI:= .577215664901533 + LN(ABSX) - Z2 * CHEPOLSUM(10,G,A)
         "END" "ELSE"
         "BEGIN" "REAL" CX,SX;
             SINCOSFG(X,F,G);
             CX:= COS(X); SX:= SIN(X);
             SI:= 1.570796326794897; "IF" X<0 "THEN" SI:= -SI;
             SI:= SI - F * CX - G * SX;
             CI:= F * SX - G * CX
         "END"
     "END" SINCOSINT
1SECTION : 6.5.2              (MARCH 1977)                        PAGE 5
 
                                                                   ;
         "EOP"
0"CODE" 35085;
     "PROCEDURE" SINCOSFG(X,F,G); "VALUE" X; "REAL" X,F,G;
     "BEGIN" "REAL" ABSX,SI,CI;
 
         ABSX:= ABS(X);
         "IF" ABSX <= 4 "THEN"
         "BEGIN" "REAL" CX,SX;
            SINCOSINT(X,SI,CI);
            CX:= COS(X); SX:= SIN(X); SI:= SI - 1.570796326794897;
            F:= CI * SX - SI * CX;
            G:=-CI * CX - SI * SX
         "END" "ELSE"
         "BEGIN" "REAL" "ARRAY" A[0:23];
             A[0] :=+9.6578828035185"-01; A[1] :=-4.3060837778597"-02;
             A[2] :=-7.3143711748104"-03; A[3] :=+1.4705235789868"-03;
             A[4] :=-9.8657685732702"-05; A[5] :=-2.2743202204655"-05;
             A[6] :=+9.8240257322526"-06; A[7] :=-1.8973430148713"-06;
             A[8] :=+1.0063435941558"-07; A[9] :=+8.0819364822241"-08;
             A[10]:=-3.8976282875288"-08; A[11]:=+1.0335650325497"-08;
             A[12]:=-1.4104344875897"-09; A[13]:=-2.5232078399683"-10;
             A[14]:=+2.5699831325961"-10; A[15]:=-1.0597889253948"-10;
             A[16]:=+2.8970031570214"-11; A[17]:=-4.1023142563083"-12;
             A[18]:=-1.0437693730018"-12; A[19]:=+1.0994184520547"-12;
             A[20]:=-5.2214239401679"-13; A[21]:=+1.7469920787829"-13;
             A[22]:=-3.8470012979279"-14;
             F:= CHEPOLSUM(22, 8/ABSX-1, A) / X;
             A[0] :=+2.2801220638241"-01; A[1] :=-2.6869727411097"-02;
             A[2] :=-3.5107157280958"-03; A[3] :=+1.2398008635186"-03;
             A[4] :=-1.5672945116862"-04; A[5] :=-1.0664141798094"-05;
             A[6] :=+1.1170629343574"-05; A[7] :=-3.1754011655614"-06;
             A[8] :=+4.4317473520398"-07; A[9] :=+5.5108696874463"-08;
             A[10]:=-5.9243078711743"-08; A[11]:=+2.2102573381555"-08;
             A[12]:=-5.0256827540623"-09; A[13]:=+3.1519168259424"-10;
             A[14]:=+3.6306990848979"-10; A[15]:=-2.2974764234591"-10;
             A[16]:=+8.5530309424048"-11; A[17]:=-2.1183067724443"-11;
             A[18]:=+1.7133662645092"-12; A[19]:=+1.7238877517248"-12;
             A[20]:=-1.2930281366811"-12; A[21]:=+5.7472339223731"-13;
             A[22]:=-1.8415468268314"-13; A[23]:=+3.5937256571434"-14;
             G:= 4 * CHEPOLSUM(23, 8/ABSX-1, A) / ABSX /ABSX
         "END"
     "END" SINCOSFG;
         "EOP"
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 1
 
 
 
 AUTHOR(S) : D. T. WINTER,N.M.TEMME.
 
 
 INSTITUTE: MATHEMATICAL CENTRE
 
 
 RECEIVED: 730727
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THE FOLLOWING PROCEDURES:
 
     RECIP GAMMA:  THIS PROCEDURE CALCULATES THE RECIPROCAL OF THE GAMMA
         FUNCTION FOR ARGUMENTS IN THE RANGE [.5,1.5];  MOREOVER ODD AND
         EVEN PARTS ARE DELIVERED;
 
     GAMMA: THIS PROCEDURE CALCULATES THE GAMMA FUNCTION;
 
     LOG GAMMA:   THIS PROCEDURE CALCULATES THE NATURAL LOGARITHM OF THE
         GAMMA FUNCTION FOR POSITIVE ARGUMENTS.
 
     INCOMGAM : COMPUTES THE INCOMPLETE GAMMA FUNCTIONS CORRESPONDING
     TO THE DEFINITIONS 6.5.2 AND 6.5.3 IN REFERENCE [1].
     THE COMPUTATIONS ARE BASED ON PADE-APPROXIMATIONS.
 
     LET B(X,P,Q) = INTEGRAL FROM 0 TO X OF T**(P-1)*(1-T)**(Q-1)*DT,
     P>0, Q>0, 0<=X<=1; B IS CALLED THE INCOMPLETE BETA FUNCTION.
     LET I(X,P,Q) = B(X,P,Q)/B(1,P,Q); I IS CALLED THE INCOMPLETE BETA
     FUNCTION RATIO.
 
     INCBETA : COMPUTES I(X,P,Q); 0<=X<=1, P>0, Q>0;
     IBPPLUSN: COMPUTES I(X,P+N,Q) FOR N=0(1)NMAX, 0<=X<=1, P>0, Q>0;
     IBQPLUSN: COMPUTES I(X,P,Q+N) FOR N=0(1)NMAX, 0<=X<=1, P>0, Q>0.
     THE REMAINING FOUR PROCEDURES ARE AUXILIARY PROCEDURES
     FOR INCBETA, IBPPLUSN AND IBQPLUSN.
 
 
 KEYWORDS:
 
     GAMMA-FUNCTION,
     INCOMPLETE GAMMA-FUNCTION,
     PADE-APPROXIMATION,
     CONTINUED FRACTION,
     INCOMPLETE BETA-FUNCTION,
     INCOMPLETE BETA-FUNCTION RATIO.
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 2
 
 
 
 SUBSECTION : RECIP GAMMA.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THIS PROCEDURE IS:
     "REAL" "PROCEDURE" RECIP GAMMA(X, ODD, EVEN);
     "VALUE" X; "REAL" X, ODD, EVEN;
     "CODE" 35060;
 
     RECIP GAMMA:= 1/GAMMA(1-X).
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT.  THIS ARGUMENT SHOULD SATISFY  -.5  <=  X  < = .5
         (ACTUALLY THE GAMMA FUNCTION IS CALCULATED FOR  1 - X,  I.E. IF
         ONE WANTS TO CALCULATE 1/GAMMA(1), ONE HAS TO SET X TO 0);
     ODD: <IDENTIFIER>;
         EXIT: THE ODD PART OF 1 / GAMMA(1 - X) DIVIDED BY (2 * X); I.E.
             (1 / GAMMA(1 - X) - 1 / GAMMA(1 + X)) / (2 * X);
     EVEN: <IDENTIFIER>;
         EXIT:  THE EVEN PART OF  1 / GAMMA(1 - X)  DIVIDED  BY  2; I.E.
             (1 / GAMMA(1 - X) + 1 / GAMMA(1 + X)) / 2;
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
 
     EXECUTION FIELD LENGTH: AN ARRAY OF 12 ELEMENTS IS USED.
 
 
 LANGUAGE: ALGOL-60.
 
 
 METHOD AND PERFORMANCE:
 
     THE RECIPROCAL OF THE GAMMA FUNCTION IS APPROXIMATED BY A TRUNCATED
     CHEBYSHEV SERIES. ODD AND EVEN PART ARE CALCULATED SEPARATELY.  THE
     COEFFICIENTS OF THE CHEBYSHEV SERIES AS GIVEN IN THE PROCEDURE TEXT
     SHOULD GUARANTEE A PRECISION OF 14 DECIMAL DIGITS, HOWEVER AS THESE
     COEFFICIENTS  CAN NOT BE  READ IN  FULL  PRECISION  UNDER  CD-ALGOL
     VERSION 3, THIS PRECISION CAN NOT BE GUARANTEED.  A PRECISION OF 13
     DECIMAL DIGITS HOWEVER WILL BE OBTAINED.  MOREOVER FOR THE ARGUMENT
     1 (I.E. X = 0) EVEN AND RECIP GAMMA BOTH YIELD THE CORRECT VALUE.
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 3
 
 
 
 EXAMPLE OF USE:
 
     THE FOLLOWING PROGRAM:
     "BEGIN" "REAL" X, ODD, EVEN;
         X:= RECIP GAMMA(.4, ODD, EVEN);
         OUTPUT(61, "(""("0.4")", 3(N), /")", X, ODD, EVEN);
         X:= RECIP GAMMA(0, ODD, EVEN);
         OUTPUT(61, "(""("0.0")", 3(N)")", X, ODD, EVEN)
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 0.4 +6.7150497244208"-001  -5.6944440692994"-001  +8.9928273521406"-001
 0.0 +1.0000000000000"+000  -5.7721566490154"-001  +1.0000000000000"+000
 
 
 SUBSECTION : GAMMA.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" GAMMA(X); "VALUE" X; "REAL" X;
     "CODE" 35061;
 
     GAMMA:= THE VALUE OF THE GAMMA-FUNCTION AT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT.  IF ONE  OF THE  FOLLOWING  THREE  CONDITIONS  IS
         FULFILLED OVERFLOW WILL OCCUR:
         1:  THE ARGUMENT IS TOO LARGE (> 177);
         2:  THE ARGUMENT IS A NON-POSITIVE INTEGER;
         3:  THE ARGUMENT IS TOO 'CLOSE' TO A LARGE  (IN ABSOLUTE VALUE)
             NON-POSITIVE INTEGER.
 
 
 PROCEDURES USED:
 
     RECIP GAMMA = CP35060
     LOG GAMMA   = CP35062.
 
 
 REQUIRED CENTRAL MEMORY:
 
     EXECUTION FIELD LENGTH: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 LANGUAGE: ALGOL-60.
 
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 4
 
 
 
 METHOD AND PERFORMANCE:
     WE  DISTINGUISH  BETWEEN THE  FOLLOWING  CASES FOR  THE ARGUMENT X:
     X < .5:
         IN THIS CASE THE FORMULA GAMMA(X) * GAMMA(1-X) = PI / SIN(PI*X)
         IS USED.  HOWEVER THE SINE FUNCTION IS NOT CALCULATED  DIRECTLY
         ON THE ARGUMENT PI*X BUT ON THE ARGUMENT PI*(X MOD .5), IN THIS
         WAY A BIG DECREASE OF PRECISION IS AVOIDED.  THE PRECISION HERE
         DEPENDS STRONGLY ON THE PRECISION OF THE SINE FUNCTION; HOWEVER
         A PRECISION BETTER THAN  12  DECIMAL DIGITS CAN BE  EXPECTED IN
         THE GAMMA FUNCTION.
     .5 <= X <= 1.5:
         HERE THE PROCEDURE  RECIP GAMMA IS CALLED.  A PRECISION OF MORE
         THAN 13 DECIMAL DIGITS IS OBTAINED; MOREOVER: GAMMA(1) = 1.
     1.5 < X <= 22:
         THE  RECURSION  FURMULA  GAMMA(1 + X) = X * GAMMA(X)  IS  USED.
         THE PRECISION DEPENDS ON THE  NUMBER OF  RECURSIONS  NEEDED,  A
         PRECISION BETTER THAN 10 DECIMAL DIGITS IS ALWAYS OBTAINED. THE
         UPPERBOUND OF  22  HAS BEEN CHOSEN,  BECAUSE NOW  IT IS ASSURED
         THAT FOR ALL INTEGER ARGUMENTS FOR WHICH THE VALUE OF THE GAMMA
         FUNCTION IS REPRESENTABLE (AND THIS IS THE CASE FOR ALL INTEGER
         ARGUMENTS IN THE RANGE  [1,22]),  THIS VALUE IS OBTAINED,  I.E.
         GAMMA(I) = 1 * 2 * ... * (I - 1).
     X > 22:
         NOW THE PROCEDURES  LOG GAMMA AND  EXP ARE USED.  THE PRECISION
         STRONGLY DEPENDS ON THE  PRECISION OF THE EXPONENTIAL FUNCTION,
         AND NO BOUND FOR THE ERROR CAN BE GIVEN.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
     "BEGIN" "REAL" X;
         "FOR" X:= -8.5, .25, 1.5, 22, 50 "DO"
         OUTPUT(61, "("+2Z.2D3B, N, /")", X, GAMMA(X))
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 
      -8.50   -2.6335215159963"-005
       +.25   +3.6256099082219"+000
      +1.50   +8.8622692545276"-001
     +22.00   +5.1090942171709"+019
     +50.00   +6.0828186403422"+062
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 5
 
 
 
 SUBSECTION : LOG GAMMA.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE IS:
     "REAL" "PROCEDURE" LOG GAMMA(X); "VALUE" X; "REAL" X;
     "CODE" 35062;
 
     LOG GAMMA:= THE NATURAL LOGARITHM OF THE GAMMA FUNCTION AT X.
 
     THE MEANING OF THE FORMAL PARAMETER IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT. THIS ARGUMENT MUST BE POSITIVE.
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY:
 
     EXECUTION FIELD LENGTH: AN ARRAY OF 18 ELEMENTS IS USED.
 
 
 LANGUAGE: ALGOL-60.
 
 
 METHOD AND PERFORMANCE:
     WE DISTIGUISH BETWEEN THE  FOLLOWING CASES FOR THE ARGUMENT  X  (IN
     MOST CASES NOTHING IS SAID ABOUT PRECISION,  AS THIS HIGHLY DEPENDS
     ON THE  PRECISION OF  THE NATURAL LOGARITHM;  HOWEVER,  A PRECISION
     BETTER THAN 11 DECIMAL DIGITS IS ALWAYS OBTAINED):
     0 < X < 1:
         HERE THE RECURSION FORMULA (LOG GAMMA(X)=LOG GAMMA(1+X)-LN(X) )
         IS USED.
     1 <= X <= 2:
         ON  THIS  INTERVAL  THE  TRUNCATED  CHEBYSHEV  SERIES  FOR  THE
         FUNCTION  LOG GAMMA(X) / ((X-1)*(X-2))  IS USED.  IN THIS WAY A
         PRECISION BETTER THAN 13 DECIMAL DIGITS IS ASSURED.
     2 < X <= 13:
         THE RECURSION FORMULA  LOG GAMMA(X) = LOG GAMMA(1-X) + LN(X) IS
         USED.
     13 < X <= 22:
         AS FOR X < 1 THE FORMULA LOG GAMMA(X) = LOG GAMMA(1+X)-LN(X) IS
         USED.
     X < 22:
         IN THIS CASE LOG GAMMA IS  CALCULATED BY USE OF THE  ASYMPTOTIC
         EXPANSION FOR LOG GAMMA(X) - (X - .5) * LN(X) .
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 6
 
 
 
 EXAMPLE OF USE:
 
     THE FOLLOWING PROGRAM:
     "BEGIN" "REAL" X;
         "FOR" X:= .25, 1.5, 12, 15, 80 "DO"
         OUTPUT(61, "("+2Z.2D3B, N, /")", X, LOG GAMMA(X))
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 
       +.25   +1.2880225246981"+000
      +1.50   -1.2078223763524"-001
     +12.00   +1.7502307845874"+001
     +15.00   +2.5191221182739"+001
     +80.00   +2.6929109765102"+002
 
 
 SUBSECTION : INCOMGAM.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" INCOMGAM(X,A,KLGAM,GRGAM,GAM,EPS);
     "VALUE" X,A,EPS; "REAL" X,A,KLGAM,GRGAM,GAM,EPS;
     "CODE" 35030;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:       <ARITHMETIC EXPRESSION>;
              THE INDEPENDENT ARGUMENT X, X>=0;
     A:       <ARITHMETIC EXPRESSION>;
              THE INDEPENDENT PARAMETER A, A>0;
     KLGAM:   <VARIABLE>;
              EXIT: THE INTEGRAL FROM 0 TO X OF EXP(-T)*T**(A-1)*DT
              IS DELIVERED IN KLGAM;
     GRGAM:   <VARIABLE>;
              EXIT: THE INTEGRAL FROM X TO INFINITY OF EXP(-T)*
              T**(A-1)*DT IS DELIVERED IN GRGAM;
     GAM:     <ARITHMETIC EXPRESSION>;
              ENTRY: THE VALUE OF THE GAMMAFUNCTION WITH ARGUMENT A.
              FOR THIS EXPRESSION THE "REAL" "PROCEDURE" GAMMA(X);
              "CODE" 35061 MAY BE USED;
     EPS:     <ARITHMETIC EXPRESSION>;
              ENTRY: THE DESIRED RELATIVE ACCURACY. THE VALUE OF EPS
              SHOULD NOT BE SMALLER THAN THE MACHINE ACCURACY,
              WHICH IS ABOUT "-14.
 
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 7
 
 
 
 PROCEDURES USED: NONE.
 
 
 RUNNING TIME: DEPENDS ON THE VALUES OF X,A,EPS.
     FOR THE EXAMPLE BELOW THE EXECUTION TIME IS 0.003 SEC.
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
 
     FOR THE METHOD SEE REFERENCE [4]. THE RELATIVE ACCURACY OF THE
     RESULTS DEPENDS NOT ONLY ON THE QUANTITY EPS, BUT ALSO ON THE
     ACCURACY OF THE FUNCTIONS EXP AND GAMMA. ESPECIALLY FOR LARGE
     VALUES OF X AND A THE DESIRED ACCURACY CANNOT BE GUARANTEED.
 
 
 REFERENCES:
     SEE REFERENCES [1] AND [4] OF THE PROCEDURE IBQPLUSN(THIS SECTION).
 
 
 EXAMPLE OF USE:
 
 "BEGIN" "REAL" P,Q;
 
     INCOMGAM(3,4,P,Q,1*2*3.0,2.0**(-48));
     "COMMENT" 1*2*3 = GAMMA(4);
     OUTPUT(61,"("/,"("KLGAM AND GRGAM ARE")",
     /,2(N)")",P,Q);
 "END"
 
     DELIVERS:
 
 KLGAM AND GRGAM ARE
 +2.1166086673066"+000  +3.8833913326934"+000.
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 8
 
 
 
 SUBSECTION : INCBETA.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" INCBETA(X,P,Q,EPS);
      "VALUE" X,P,Q,EPS; "REAL" X,P,Q,EPS;
     "CODE" 35050;
 
     INCBETA DELIVERS THE VALUE OF I(X,P,Q);
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY 0<=X<=1;
     P:      <ARITHMETIC EXPRESSION>;
             PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; P>0;
     Q:      <ARITHMETIC EXPRESSION>;
             PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; Q>0;
     EPS:    <ARITHMETIC EXPRESSION>;
             ENTRY: THE DESIRED RELATIVE ACCURACY; EPS SHOULD NOT BE
             SMALLER THAN THE MACHINE ACCURACY.
 
 
 
 PROCEDURES USED: GAMMA = CP 35061.
 
 
 REQUIRED CENTRAL MEMORY:
 
     EXECUTION FIELD LENGTH: NO AUXILIARY ARRAYS ARE USED.
 
 
 METHOD AND PERFORMANCE:
 
     THE INCOMPLETE BETA FUNCTION I(X,P,Q) IS APPROXIMATED BY THE
     CONTINUED FRACTION CORRESPONDING TO FORMULA 26.5.8 IN REFERENCE[1].
     IF X > .5 THE RELATION I(X,P,Q) = 1 - I(1-X,Q,P) IS USED. IT IS
     ADVISED TO USE IN INCBETA ONLY SMALL VALUES OF P AND Q, SAY
     0 < P <= 5, 0 < Q <= 5. FOR OTHER RANGES OF THE PARAMETERS P AND Q
     THE PROCEDURES IBPPLUSN AND IBQPLUSN CAN BE USED.
     INCBETA SATISFIES INCBETA = X IF X = 0 OR X = 1, WHATEVER P AND Q.
     THERE IS NO CONTROL ON THE PARAMETERS X,P,Q FOR THEIR INTENDED
     RANGES.
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                    PAGE 9
 
 
 
 REFERENCES: SEE REFERENCES [1], [2] AND [3] OF THE PROCEDURE
     IBQPLUSN (THIS SECTION).
 
 
 EXAMPLE OF USE:
 
     THE FOLLOWING PROGRAM:
 
     "BEGIN"
     OUTPUT(61,"("N")",INCBETA(.3,1.4,1.5,1/2**46))
     "END"
 
     YIELDS THE FOLLOWING RESULT:
 
     +2.7911593308577"-001.
 
 
 SUBSECTION : IBPPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" IBPPLUSN(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
     "INTEGER" NMAX; "REAL" X,P,Q,EPS; "ARRAY" I;
     "CODE" 35051;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY 0<=X<=1;
     P:      <ARITHMETIC EXPRESSION>;
             PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; P>0.
             IT IS ADVISED TO TAKE 0<P<=1;
     Q:      <ARITHMETIC EXPRESSION>;
             PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; Q>0;
     NMAX:   <ARITHMETIC EXPRESSION>;
             NMAX INDICATES THE MAXIMUM NUMBER OF FUNCTION VALUES
             I(X,P+N,Q) TO BE GENERATED;
     EPS:    <ARITHMETIC EXPRESSION>;
             ENTRY: THE DESIRED RELATIVE ACCURACY; EPS SHOULD NOT BE
             SMALLER THAN THE MACHINE ACCURACY;
     I:      <ARRAY IDENTIFIER>;
             "ARRAY" I[0:NMAX]; NMAX>=0;
             EXIT: I[N] = I(X,P+N,Q) FOR N=0(1)NMAX.
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 10
 
 
 
 PROCEDURES USED:
 
     IXQFIX   = CP 35053;
     IXPFIX   = CP 35054.
     BOTH PROCEDURES IXQFIX AND IXPFIX CALL FOR
     INCBETA  = CP 35050;
     FORWARD  = CP 35055;
     BACKWARD = CP 35056.
 
 
 REQUIRED CENTRAL MEMORY:
 
     EXECUTION FIELD LENGTH: AN ARRAY OF NMAX + 1 ELEMENTS IS TO BE
     INSERTED BY THE USER. AN AUXILIARY ARRAY OF ENTIER(Q) + 1
     ELEMENTS IS DECLARED IN THE AUXILIARY PROCEDURES.
 
 
 METHOD AND PERFORMANCE:
 
     SEE REFERENCE [2] AND [3]. IN [2] THE PROCEDURE IBPPLUSN IS
     CALLED INCOMPLETE BETA Q FIXED. THERE IS NO CONTROL ON THE
     PARAMETERS X,P,Q,NMAX FOR THEIR INTENDED RANGES.
 
 
 REFERENCES: SEE REFERENCES [1], [2] AND [3] OF THE PROCEDURE
     IBQPLUSN (THIS SECTION).
 
 
 EXAMPLE OF USE:
 
     THE FOLLOWING PROGRAM:
 
     "BEGIN" "REAL" "ARRAY" ISUBX[0:2];
         IBPPLUSN(.3,.4,1.5,2,1/2**46,ISUBX);
         OUTPUT(61,"("3(N)")",ISUBX[0],ISUBX[1],ISUBX[2])
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 
     +7.2167087410147"-001 +2.7911593308576"-001 +9.8932849957944"-002.
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 11
 
 
 
 SUBSECTION : IBQPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" IBQPLUSN(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
     "INTEGER" NMAX; "REAL" X,P,Q,EPS; "ARRAY" I;
     "CODE" 35052;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY 0<=X<=1;
     P:      <ARITHMETIC EXPRESSION>;
             PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; P>0;
     Q:      <ARITHMETIC EXPRESSION>;
             PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; Q>0;
             IT IS ADVISED TO TAKE 0<Q<=1;
     NMAX:   <ARITHMETIC EXPRESSION>;
             NMAX INDICATES THE MAXIMUM NUMBER OF FUNCTION VALUES
             I(X,P,Q+N) TO BE GENERATED;
     EPS:    <ARITHMETIC EXPRESSION>;
             ENTRY: THE DESIRED RELATIVE ACCURACY; EPS SHOULD NOT BE
             SMALLER THAN THE MACHINE ACCURACY;
     I:      <ARRAY IDENTIFIER>;
             "ARRAY" I[0:NMAX]; NMAX>=0;
             EXIT: I[N] = I(X,P,Q+N) FOR N=0(1)NMAX.
 
 
 PROCEDURES USED:
 
     IXQFIX   = CP 35053;
     IXPFIX   = CP 35054.
     BOTH PROCEDURES IXQFIX AND IXPFIX CALL FOR
     INCBETA  = CP 35050;
     FORWARD  = CP 35055;
     BACKWARD = CP 35056.
 
 
 REQUIRED CENTRAL MEMORY:
 
     EXECUTION FIELD LENGTH: AN ARRAY OF NMAX + 1 ELEMENTS IS TO BE
     INSERTED BY THE USER. AN AUXILIARY ARRAY OF ENTIER(P) + 1
     ELEMENTS IS DECLARED IN THE AUXILIARY PROCEDURES.
 
 
 METHOD AND PERFORMANCE:
 
     SEE REFERENCE [2] AND [3]. IN [2] THE PROCEDURE IBQPLUSN IS
     CALLED INCOMPLETE BETA P FIXED. THERE IS NO CONTROL ON THE
     PARAMETERS X,P,Q,NMAX FOR THEIR INTENDED RANGES.
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 12
 
 
 
 REFERENCES:
 
     [1].M.ABRAMOWITZ AND I.A.STEGUN (ED.).
         HANDBOOK OF MATHEMATICAL FUNCTIONS.
         DOVER PUBLICATIONS, INC., NEW YORK, 1965.
 
     [2].W.GAUTSCHI. COMM.A.C.M. 7, 1964, ALGORITHM 222, P 143.
 
     [3].W.GAUTSCHI. SIAM REV. 9, 1967, PP 24-82.
 
     [4].Y.L.LUKE. SIAM J. MATH. ANAL. VOL.1, 1971, PP. 266-281.
 
 
 EXAMPLE OF USE:
 
     THE FOLLOWING PROGRAM:
 
     "BEGIN" "REAL" "ARRAY" ISUBX[0:2];
         IBQPLUSN(.3,1.4,.5,2,1/2**46,ISUBX);
         OUTPUT(61,"("3(N)")",ISUBX[0],ISUBX[1],ISUBX[2])
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 
     +8.9449529793325"-002 +2.7911593308576"-001 +4.4728681067173"-001.
 
 
 THE REMAINING PROCEDURES AND SUBSECTIONS ARE:
 
 
 THE REMAINING PROCEDURES AND SUBSECTIONS ARE:
 
 SUBSECTION : IXQFIX.
 CALLING SEQUENCE :
     "PROCEDURE" IXQFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
     "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I;
     "CODE" 35053;
 
 SUBSECTION : IXPFIX.
 CALLING SEQUENCE :
     "PROCEDURE" IXPFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
     "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I;
     "CODE" 35054;
 
 SUBSECTION : FORWARD.
 CALLING SEQUENCE :
     "PROCEDURE" FORWARD(X,P,Q,I0,I1,NMAX,I);
     "VALUE" X,P,Q,I0,I1,NMAX; "INTEGER" NMAX; "REAL" X,P,Q,I0,I1;
     "ARRAY" I;
     "CODE" 35055;
 
1SECTION : 6.6                (SEPTEMBER 1974)                  PAGE 12A
 
 
 
 SUBSECTION : BACKWARD.
 CALLING SEQUENCE :
     "PROCEDURE" BACKWARD(X,P,Q,I0,NMAX,EPS,I);
     "VALUE" X,P,Q,I0,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,I0,EPS;
     "ARRAY" I;
     "CODE" 35056;
 
     THESE AUXILIARY PROCEDURES ARE NOT DESCRIBED HERE. MORE INFORMATION
     CAN BE FOUND IN REFERENCE [2], WHERE THE PROCEDURES FORWARD AND
     BACKWARD HAVE THE SAME NAME, WHILE IXQFIX AND IXPFIX ARE CALLED
     ISUBXQFIXED AND ISUBXPFIXED RESPECTIVELY. IN THE PROCEDURE
     BACKWARD WE CHANGED THE STARTING VALUE NU FOR THE BACKWARD
     RECURRENCE ALGORITHM. THE NEW VALUE OF NU IS MORE REALISTIC.
     ITS COMPUTATION IS BASED ON SOME ASYMPTOTIC ESTIMATIONS. ALSO
     THE INITIAL VALUE R=0 IS CHANGED INTO R=X.
 
 
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 13
 
 
 
 SOURCE TEXT(S) :
0"CODE" 35060;
 "REAL" "PROCEDURE" RECIP GAMMA(X, ODD, EVEN);
 "VALUE" X; "REAL" X, ODD, EVEN;
 "BEGIN" "INTEGER" I;
     "REAL" ALFA, BETA, X2;
     "ARRAY" B[1:12];
     B[ 1]:= -.28387 65422 76024; B[ 2]:= -.07685 28408 44786;
     B[ 3]:= +.00170 63050 71096; B[ 4]:= +.00127 19271 36655;
     B[ 5]:= +.00007 63095 97586; B[ 6]:= -.00000 49717 36704;
     B[ 7]:= -.00000 08659 20800; B[ 8]:= -.00000 00331 26120;
     B[ 9]:= +.00000 00017 45136; B[10]:= +.00000 00002 42310;
     B[11]:= +.00000 00000 09161; B[12]:= -.00000 00000 00170;
     X2:= X * X * 8;
     ALFA:= -.00000 00000 00001; BETA:= 0;
     "FOR" I:= 12 "STEP" - 2 "UNTIL" 2 "DO"
     "BEGIN" BETA:= -(ALFA * 2 + BETA); ALFA:= - BETA * X2 - ALFA + B[I]
     "END";
     EVEN:= (BETA / 2 + ALFA) * X2 - ALFA + .92187 02936 50453;
     ALFA:= -.00000 00000 00034; BETA:= 0;
     "FOR" I:= 11 "STEP" - 2 "UNTIL" 1 "DO"
     "BEGIN" BETA:= -(ALFA * 2 + BETA); ALFA:= - BETA * X2 - ALFA + B[I]
     "END";
     ODD:= (ALFA + BETA) * 2;
     RECIP GAMMA:= ODD * X + EVEN
 "END" RECIP GAMMA;
         "EOP"
0"CODE" 35061;
 "REAL" "PROCEDURE" GAMMA(X); "VALUE" X; "REAL" X;
 "BEGIN" "REAL" Y, S, F, G, ODD, EVEN;
     "BOOLEAN" INV;
     "IF" X < .5 "THEN"
     "BEGIN" Y:= X - ENTIER(X / 2) * 2; S:= 3.14159 26535 8979;
         "IF" Y >= 1 "THEN" "BEGIN" S:= - S; Y:= 2 - Y "END";
         "IF" Y >= .5 "THEN" Y:= 1 - Y; INV:= "TRUE"; X:= 1 - X;
         F:= S / SIN(3.14159 26535 8979 * Y)
     "END"
     "ELSE" INV:= "FALSE";
     "IF" X > 22 "THEN" G:= EXP(LOG GAMMA(X)) "ELSE"
     "BEGIN" S:= 1;
     NEXT: "IF" X > 1.5 "THEN"
         "BEGIN" X:= X - 1; S:= S * X; "GOTO" NEXT "END";
         G:= S / RECIP GAMMA(1 - X, ODD, EVEN)
     "END";
     GAMMA:= "IF" INV "THEN" F / G "ELSE" G
 "END" GAMMA
 
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 14
 
                                                                  ;
         "EOP"
0"CODE" 35062;
 "REAL" "PROCEDURE" LOG GAMMA(X); "VALUE" X; "REAL" X;
 "IF" X > 13 "THEN"
 "BEGIN" "REAL" R, X2;
     R:= 1;
 NEXT: "IF" X <= 22 "THEN"
     "BEGIN" R:= R / X; X:= X + 1; "GOTO" NEXT "END";
     X2:= - 1 / (X * X); R:= LN(R);
     LOG GAMMA:= LN(X) * (X - .5) - X + R + .91893 85332 04672 +
     (((.59523 80952 38095"-3  * X2 + .79365 07936 50794"-3) * X2 +
        .27777 77777 77778"-2) * X2 + .83333 33333 33333"-1) / X
 "END"
 "ELSE"
 "BEGIN" "REAL" Y, F, U0, U1, U, Z;
     "INTEGER" I;
     "ARRAY" B[1:18];
     F:= 1; U0:= U1:= 0;
     B[ 1]:= -.07611 41616 704358; B[ 2]:= +.00843 23249 659328;
     B[ 3]:= -.00107 94937 263286; B[ 4]:= +.00014 90074 800369;
     B[ 5]:= -.00002 15123 998886; B[ 6]:= +.00000 31979 329861;
     B[ 7]:= -.00000 04851 693012; B[ 8]:= +.00000 00747 148782;
     B[ 9]:= -.00000 00116 382967; B[10]:= +.00000 00018 294004;
     B[11]:= -.00000 00002 896918; B[12]:= +.00000 00000 461570;
     B[13]:= -.00000 00000 073928; B[14]:= +.00000 00000 011894;
     B[15]:= -.00000 00000 001921; B[16]:= +.00000 00000 000311;
     B[17]:= -.00000 00000 000051; B[18]:= +.00000 00000 000008;
     "IF" X < 1 "THEN"
     "BEGIN" F:= 1 / X; X:= X + 1 "END"
     "ELSE"
 NEXT: "IF" X > 2 "THEN"
     "BEGIN" X:= X - 1; F:= F * X; "GOTO" NEXT "END";
     F:= LN(F); Y:= X + X - 3; Z:= Y + Y;
     "FOR" I:= 18 "STEP" - 1 "UNTIL" 1 "DO"
     "BEGIN" U:= U0; U0:= Z * U0 + B[I] - U1; U1:= U "END";
     LOG GAMMA:= (U0 * Y + .49141 53930 29387 - U1) * (X - 1) * (X - 2)
     + F
 "END" LOG GAMMA
1SECTION : 6.6                (MARCH 1977)                       PAGE 15
 
                                                                  ;
         "EOP"
0"CODE" 35030;
     "PROCEDURE" INCOMGAM(X,A,KLGAM,GRGAM,GAM,EPS);
     "VALUE" X,A,EPS; "REAL" X,A,KLGAM,GRGAM,GAM,EPS;
     "BEGIN" "REAL" C0,C1,C2,D0,D1,D2,X2,AX,P,Q,R,S,R1,R2,SCF;
         "INTEGER" N;
         S:= EXP(-X + A * LN(X)); SCF:= "+300;
         "IF" X <= ("IF" A < 3 "THEN" 1 "ELSE" A) "THEN"
         "BEGIN" X2:= X * X; AX:= A * X; D0:= 1; P:= A; C0:= S;
             D1:=(A+1)*(A+2-X); C1:=((A+1) * (A+2)+X) * S;
              R2:= C1/D1;
              "FOR" N:= 1, N+1 "WHILE" ABS((R2-R1)/R2) > EPS "DO"
                 "BEGIN" P:= 2+P; Q:= (P+1) * (P*(P+2)-AX);
                 R:= N * (N+A) * (P+2) * X2;
                 C2:= (Q*C1 + R*C0)/P; D2:= (Q*D1 + R*D0)/P;
                  R1:=R2; R2:=C2/D2;
                 C0:=C1; C1:=C2; D0:=D1; D1:=D2;
                 "IF" ABS(C1) > SCF "OR" ABS(D1) > SCF "THEN"
                "BEGIN" C0:= C0/SCF; C1:= C1/SCF;
                        D0:= D0/SCF; D1:= D1/SCF
                "END"
             "END"; KLGAM:= R2/A; GRGAM:= GAM - KLGAM
         "END" "ELSE"
         "BEGIN" C0:=A*S; C1:=(1+X)* C0; Q:= X +2  - A;
             D0:= X; D1:= X * Q; R2:= C1/D1;
             "FOR" N:=1, N+1 "WHILE" ABS((R2-R1)/R2)>EPS "DO"
             "BEGIN"     Q:= 2 + Q; R:= N * (N+1-A);
                 C2:= Q*C1-R*C0; D2:= Q*D1-R*D0;
                 R1:=R2; R2:=C2/D2;
                 C0:=C1; C1:=C2; D0:=D1; D1:=D2;
                 "IF" ABS(C1) > SCF "OR" ABS(D1) > SCF "THEN"
                "BEGIN" C0:= C0/SCF; C1:= C1/SCF;
                        D0:= D0/SCF; D1:= D1/SCF
                "END"
             "END"; GRGAM:= R2/A; KLGAM:= GAM - GRGAM
         "END"
     "END" INCOMGAM
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 16
 
                                                                  ;
         "EOP"
0"CODE" 35050;
 "REAL" "PROCEDURE" INCBETA(X,P,Q,EPS);
 "VALUE" X,P,Q,EPS; "REAL" X,P,Q,EPS;
 "BEGIN" "INTEGER" M,N; "REAL" G,F,FN,FN1,FN2,GN,GN1,GN2,DN,PQ;
     "BOOLEAN" N EVEN,RECUR;
 
     "IF" X=0 "OR" X=1 "THEN" INCBETA:= X "ELSE"
     "BEGIN" "IF" X>.5 "THEN"
         "BEGIN" F:= P; P:= Q; Q:= F; X:= 1-X; RECUR:= "TRUE""END"
         "ELSE" RECUR:= "FALSE";
         G:= FN2:= 0; M:= 0; PQ:= P+Q; F:= FN1:= GN1:= GN2:= 1;
         N EVEN:= "FALSE";
         "FOR" N:= 1,N+1 "WHILE" ABS((F-G)/F) > EPS "DO"
         "BEGIN" "IF" N EVEN "THEN"
             "BEGIN" M:= M+1; DN:= M*X*(Q-M)/(P+N-1)/(P+N) "END"
             "ELSE" DN:= -X*(P+M)*(PQ+M)/(P+N-1)/(P+N);
             G:= F; FN:= FN1+DN*FN2; GN:= GN1+DN*GN2;
             N EVEN:= ^ N EVEN; F:= FN/GN;
             FN2:= FN1; FN1:= FN; GN2:= GN1; GN1:= GN
         "END";
         F:= F*X**P*(1-X)**Q*GAMMA(P+Q)/GAMMA(P+1)/GAMMA(Q);
         "IF" RECUR "THEN" F:= 1-F;
         INCBETA:= F
     "END"
 "END" INCBETA;
         "EOP"
0"CODE" 35051;
 "PROCEDURE" IBPPLUSN(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
 "INTEGER" NMAX; "REAL" X,P,Q,EPS; "ARRAY" I;
 "BEGIN" "INTEGER" N;
 
     "IF" X=0 "OR" X=1 "THEN"
     "BEGIN" "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= X "END"
     "ELSE"
     "BEGIN" "IF" X <=.5 "THEN" IXQFIX(X,P,Q,NMAX,EPS,I) "ELSE"
         "BEGIN" IXPFIX(1-X,Q,P,NMAX,EPS,I);
             "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= 1-I[N]
         "END"
     "END"
 "END" IBPPLUSN
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 17
 
                                                                  ;
         "EOP"
0"CODE" 35052;
 "PROCEDURE" IBQPLUSN(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
 "INTEGER" NMAX; "REAL" X,P,Q,EPS; "ARRAY" I;
 "BEGIN" "INTEGER" N;
 
     "IF" X=0 "OR" X=1 "THEN"
     "BEGIN" "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= X "END"
     "ELSE"
     "BEGIN" "IF" X <=.5 "THEN" IXPFIX(X,P,Q,NMAX,EPS,I) "ELSE"
         "BEGIN" IXQFIX(1-X,Q,P,NMAX,EPS,I);
             "FOR" N:= 0 "STEP" 1 "UNTIL" NMAX "DO" I[N]:= 1-I[N]
         "END"
     "END"
 "END" IBQPLUSN;
         "EOP"
0"CODE" 35053;
 "PROCEDURE" IXQFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
 "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I;
 "BEGIN" "INTEGER" M,MMAX; "REAL" S,IQ0,IQ1,Q0;
 
     M:= ENTIER(Q); S:= Q-M; Q0:= "IF" S>0 "THEN" S "ELSE" S+1;
     MMAX:= "IF" S>0 "THEN" M "ELSE" M-1;
     IQ0:= INCBETA(X,P,Q0,EPS);
     "IF" MMAX>0 "THEN" IQ1:= INCBETA(X,P,Q0+1,EPS);
     "BEGIN" "ARRAY" IQ[0:MMAX];
         FORWARD(X,P,Q0,IQ0,IQ1,MMAX,IQ);
         BACKWARD(X,P,Q,IQ[MMAX],NMAX,EPS,I)
     "END"
 "END" IXQFIX
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 18
 
                                                                  ;
         "EOP"
0"CODE" 35054;
 "PROCEDURE" IXPFIX(X,P,Q,NMAX,EPS,I); "VALUE" X,P,Q,NMAX,EPS;
 "REAL" X,P,Q,EPS; "INTEGER" NMAX; "ARRAY" I;
 "BEGIN" "INTEGER" M,MMAX; "REAL" S,P0,I0,I1,IQ0,IQ1;
 
     M:= ENTIER(P); S:= P-M; P0:= "IF" S>0 "THEN" S "ELSE" S+1;
     MMAX:= "IF" S>0 "THEN" M "ELSE" M-1;
     I0:= INCBETA(X,P0,Q,EPS);
     I1:= INCBETA(X,P0,Q+1,EPS);
     "BEGIN" "ARRAY" IP[0:MMAX];
         BACKWARD(X,P0,Q,I0,MMAX,EPS,IP); IQ0:= IP[MMAX];
         BACKWARD(X,P0,Q+1,I1,MMAX,EPS,IP); IQ1:= IP[MMAX]
     "END";
     FORWARD(X,P,Q,IQ0,IQ1,NMAX,I)
 "END" IXPFIX;
         "EOP"
0"CODE" 35055;
 "PROCEDURE" FORWARD(X,P,Q,I0,I1,NMAX,I);
 "VALUE" X,P,Q,I0,I1,NMAX; "INTEGER" NMAX; "REAL" X,P,Q,I0,I1;
 "ARRAY" I;
 "BEGIN" "INTEGER" M,N; "REAL" Y,R,S;
     I[0]:= I0; "IF" NMAX > 0 "THEN" I[1]:= I1;
     M:= NMAX-1; R:= P+Q-1; Y:= 1-X;
     "FOR" N:= 1 "STEP" 1 "UNTIL" M "DO"
     "BEGIN" S:= (N+R)*Y;
         I[N+1]:= ((N+Q+S)*I[N]-S*I[N-1])/(N+Q)
     "END"
 "END" FORWARD
1SECTION : 6.6                (SEPTEMBER 1974)                   PAGE 19
 
                                                                  ;
         "EOP"
0"CODE" 35056;
 "PROCEDURE" BACKWARD(X,P,Q,I0,NMAX,EPS,I);
 "VALUE" X,P,Q,I0,NMAX,EPS; "INTEGER" NMAX; "REAL" X,P,Q,I0,EPS;
 "ARRAY" I;
 "BEGIN" "INTEGER" M,N,NU; "REAL" R,PQ,Y,LOGX;
     "ARRAY" IAPPROX[0:NMAX];
     I[0]:= I0; "IF" NMAX>0 "THEN"
     "BEGIN""FOR" N:= 1 "STEP" 1 "UNTIL" NMAX "DO" IAPPROX[N]:= 0;
         PQ:= P+Q-1; LOGX:= LN(X);
         R:= NMAX+(LN(EPS)+Q*LN(NMAX))/LOGX;
         NU:= ENTIER(R-Q*LN(R)/LOGX);
 L1:     N:= NU; R:= X;
 L2:     Y:= (N+PQ)*X; R:= Y/(Y+(N+P)*(1-R));
         "IF" N<= NMAX "THEN" I[N]:= R; N:= N-1;
         "IF" N >= 1 "THEN" "GOTO" L2; R:= I0;
         "FOR" N:= 1 "STEP" 1 "UNTIL" NMAX "DO" R:= I[N]:= I[N]*R;
         "FOR" N:= 1 "STEP" 1 "UNTIL" NMAX "DO"
         "IF" ABS((I[N]-IAPPROX[N])/I[N]) > EPS "THEN"
         "BEGIN" "FOR" M:= 1 "STEP" 1 "UNTIL" NMAX "DO"
             IAPPROX[M]:= I[M]; NU:= NU+5; "GOTO" L1
         "END"
     "END"
 "END" BACKWARD;
         "EOP"
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 1
 
 
 
 AUTHOR: S.P.N. VAN KAMPEN.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 740410.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS FIVE PROCEDURES:
 
     A) THE  PROCEDURE  ERRORFUNCTION  COMPUTES  THE  ERROR FUNCTION AND
     COMPLEMENTARY ERROR FUNCTION FOR A REAL ARGUMENT, I.E.
         ERF(X)  = 2 / SQRT(PI) * INTEGRAL FROM 0 TO X OF EXP(-T ** 2)DT
     AND
         ERFC(X) = 2 / SQRT(PI) * INTEGRAL FROM X TO INFINITY OF
                   EXP(-T ** 2)DT
                 = 1 - ERF(X),
     (SEE E.G. [1] EQ. 7.1.1 AND 7.1.2);
     THESE FORMULAS  ARE RELATED TO THE NORMAL OR  GAUSSIAN PROBABILITY
     FUNCTION:
         P(X)    = 1 / SQRT(2 * PI) * INTEGRAL FROM - INFINITY TO X OF
                   EXP(-T ** 2 / 2)DT
                 = (1 + ERF(X / SQRT(2))) / 2
     AND
         Q(X)    = 1 / SQRT(2 * PI) * INTEGRAL FROM X TO INFINITY OF
                   EXP(-T ** 2 / 2)DT
                 = ERFC(X / SQRT(2)) / 2,
     (SEE E.G. [1] EQ. 26.2.2, 26.2.3 AND 26.2.29).
 
     B) THE AUXILIARY PROCEDURE NONEXPERFC COMPUTES
         EXP(X * X) * ERFC(X).
 
     C) THE PROCEDURE INVERSE ERROR FUNCTION CALCULATES THE INVERSE OF
     THE ERROR FUNCTION DEFINED BY:
         Y = INVERF(X),
     WHERE
         X = ERF(Y) =
           = 2 / SQRT(PI) * INTEGRAL FROM 0 TO Y OF EXP(-T ** 2) DT,
     (SEE THE PROCEDURE ERRORFUNCTION (THIS SECTION) ).
 
     D) THE PROCEDURE FRESNEL CALCULATES  THE FRESNEL INTEGRALS C(X) AND
     S(X) DEFINED BY
         C(X) = INTEGRAL FROM 0 TO X OF COS(PI / 2 * T * T)DT
     AND
         S(X) = INTEGRAL FROM 0 TO X OF SIN(PI / 2 * T * T)DT
     (SEE [1] EQ. 7.3.1 AND 7.3.2);
 
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 2
 
 
 
     E) THE AUXILIARY PROCEDURE FG  CALCULATES F(X) AND G(X)  DEFINED BY
         F(X) = (0.5 - S(X))COS(PI / 2 * X * X) -
                (0.5 - C(X))SIN(PI / 2 * X * X)
     AND
         G(X) = (0.5 - C(X))COS(PI / 2 * X * X) +
                (0.5 - S(X))SIN(PI / 2 * X * X)
     (SEE [1] EQ. 7.3.5 AND 7.3.6).
 
 
 KEYWORDS:
     ERROR FUNCTION,
     COMPLEMENTARY ERROR FUNCTION,
     NORMAL PROBABILITY FUNCTION,
     GAUSSIAN PROBABILITY FUNCTION,
     FRESNEL INTEGRALS,
     INVERSE ERROR FUNCTION.
 
 
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 3
 
 
 
 SUBSECTION: ERRORFUNCTION.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" ERRORFUNCTION(X, ERF, ERFC);
     "VALUE" X; "REAL" X, ERF, ERFC;
     "CODE" 35021;
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF ERF(X) AND ERFC(X);
     ERF:    <VARIABLE>;
             EXIT: THE VALUE OF ERF(X),
     ERFC:   <VARIABLE>;
             EXIT: THE VALUE OF ERFC(X).
 
 
 PROCEDURES USED: NONEXPERFC = CP35022.
 
 
 RUNNING TIME: ABOUT 0.001 100 SEC.
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
 
     SEE METHOD AND PERFORMANCE OF NONEXPERFC (THIS SECTION).
 
 
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 4
 
 
 
 SUBSECTION: NONEXPERFC.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" NONEXPERFC(X); "VALUE" X; "REAL" X;
     "CODE" 35022;
 
     NONEXPERFC DELIVERS THE VALUE OF EXP(X * X) * ERFC(X);
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF NONEXPERFC.
 
 
 PROCEDURES USED: ERRORFUNCTION = CP35021.
 
 
 RUNNING TIME: ABOUT 0.000 900 SEC.
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
 
     IF ABS(X) <= 0.5 THE VALUES  OF ERF(X) AND ERFC(X)  ARE COMPUTED IN
     THE  PROCEDURE  ERRORFUNCTION   BY  MEANS  OF   RATIONAL  CHEBYSHEV
     APPROXIMATION  AS  GIVEN  IN  [2]. ON  THIS INTERVAL  THE  VALUE OF
     NONEXPERFC(X) =  EXP(X * X) * ERFC(X) IS  COMPUTED  BY CALLING  THE
     PROCEDURE ERRORFUNCTION.
     IF ABS(X) > 0.5 THE VALUES  OF ERF(X) AND  ERFC(X) ARE  COMPUTED BY
     CALLING THE PROCEDURE NONEXPERFC, WHILE THE VALUE  OF NONEXPERFC(X)
     IS COMPUTED BY MEANS OF RATIONAL CHEBYSHEV APPROXIMATIONS  AS GIVEN
     IN [2].
     THE COMPUTED VALUES OF ERF(X)  AND ERFC(X) ARE COMPARED WITH HIGHER
     PRECISION VALUES USING 4000  PSEUDO-RANDOM  ARGUMENTS.  IT APPEARED
     THAT ERF(X)  IS COMPUTED  WITH AN AVERAGE  RELATIVE ERROR  1.93"-15
     AND A MAXIMUM RELATIVE ERROR 1.35"-14.
     IF X <  6   ERFC(X)  IS COMPUTED  WITH AN  AVERAGE  RELATIVE  ERROR
     8.87"-15 AND A MAXIMUM RELATIVE ERROR 1.55"-13.
     IF X <= 26  ERFC(X)  IS COMPUTED  WITH AN  AVERAGE  RELATIVE  ERROR
     5.71"-14 AND A MAXIMUM RELATIVE ERROR 2.70"-12.
     IF X > 26  ERFC(X)=0, BECAUSE IN THIS CASE ERFC(X) IS LESS THAN THE
     SMALLEST REPRESENTABLE POSITIVE NUMBER ON THE CD CYBER 73-28.
     FOR THIS REASON IT IS ADVISABLE TO COMPUTE FOR X > 26 NONEXPERFC(X)
     INSTEAD OF ERFC(X).
     IF X < -26.2 THE PROCEDURE NONEXPERFC WILL BE TERMINATED ABNORMALLY
     BY CAUSE OF OVERFLOW.
 
 
 REFERENCES: SEE REFERENCES [1] AND [2] OF THE PROCEDURE FG (THIS
     SECTION).
 
 
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 5
 
 
 
 EXAMPLE OF USE:
 
     WE COMPUTE  THE VALUES  OF
         ERF(1)  = 0.84270 07929 49714 8693,
         ERFC(1) = 0.15729 92070 50285 1307
     AND NONEXPERFC(100) =
         EXP(100 * 100) * ERFC(100) = 0.56416 13782 98943 2905"-2;
 
     "BEGIN"
 
         "REAL" ERF, ERFC, P;
 
         ERRORFUNCTION(1, ERF, ERFC);
         P:= NONEXPERFC(100);
         OUTPUT(61, "(""("    ERF(1)  = ")", +D.5DB5DB5D, /,
                       "("    ERFC(1) = ")", +D.5DB5DB5D, /,
                       "("    NONEXPERFC(100) = ")", +.5DB5DB5D"+D")",
                    ERF, ERFC, P);
     "END"
 
     THIS PROGRAM DELIVERS:
 
     ERF(1)  = +0.84270 07929 49713
     ERFC(1) = +0.15729 92070 50285
     NONEXPERFC(100) = +.56416 13782 98941"-2.
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 6
 
 
 
 SUBSECTION : INVERSE ERROR FUNCTION.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" INVERSE ERROR FUNCTION(X, ONEMINX, INVERF);
     "VALUE" X, ONEMINX; "REAL" X, ONEMINX, INVERF;
     "CODE" 35023;
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY:
                 THE ARGUMENT OF THE FUNCTION INVERF;
                 IT IS NECESSARY THAT -1 < X < 1;
                 IF  ABS(X) > 0.8  THE  VALUE  OF X IS  NOT  USED IN THE
                 PROCEDURE;
     ONEMINX: <ARITHMETIC EXPRESSION>;
             ENTRY:
                 IF  ABS(X) <= 0.8  THE VALUE OF ONEMINX  IS NOT USED IN
                 THE PROCEDURE; IF  ABS(X) > 0.8  ONEMINX HAS TO CONTAIN
                 THE VALUE OF 1 - ABS(X); IN THE CASE  THAT ABS(X) IS IN
                 THE NEIGHBOURHOOD  OF 1, CANCELLATION  OF  DIGITS  TAKE
                 PLACE  IN THE  CALCULATION  OF 1 - ABS(X); IF THE VALUE
                 1-ABS(X) IS KNOWN EXACTLY  FROM ANOTHER SOURCE, ONEMINX
                 HAS TO  CONTAIN  THIS  VALUE, WHICH  WILL  GIVE  BETTER
                 RESULTS;
     INVERF: <VARIABLE>;
             EXIT: THE RESULT OF THE PROCEDURE.
 
 
 PROCEDURES USED: CHEPOLSUM = CP31046,
                  UNDERFLOW = CP30009.
 
 
 RUNNING TIME: ABOUT 0.003 800 SEC.
 
 
 LANGUAGE: ALGOL 60.
 
 
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 7
 
 
 
 METHOD AND PERFORMANCE:
 
     THE FUNCTION VALUE  INVERF IS CALCULATED  ON DIFFERENT INTERVALS BY
     MEANS OF CHEBYSHEV POLYNOMIALS, OF WHICH THE COEFFICIENTS ARE GIVEN
     IN [1].
     ON THE COMPUTED RESULTS WE USED THE TESTS:
         EPS1:= ABS(ERF(INVERF(X)) / X - 1),
         EPS2:= ABS(INVERF(ERF(Y)) / Y - 1),
         EPS3:= ABS((1 - ERF(INVERF(1 - X))) / X - 1).
     IF  ABS(X) < 0.9  UPPER BOUNDS FOR  EPS1  AND  EPS2 ARE 7.1"-15 AND
     4.1"-14 RESP.
     IF  0.9 < ABS(X) < 1  CANCELLATION  OF  DIGITS  TAKE  PLACE  IN THE
     CALCULATION OF 1 - ABS(X). THIS CANCELLED DIGITS  ARE ALSO  LOST IN
     THE RESULT. IF THE VALUE  OF 1 - ABS(X) IS KNOWN EXACTLY  AND GIVEN
     IN ONEMINX , EPS1 AND EPS2 HAVE THE SAME UPPER BOUND AS BEFORE.
     IF  ABS(X) <= 0.99  AND  THE VALUE  OF 1 - ABS(X) IS KNOWN  EXACTLY
     EPS3 <= 3.6"-14.
     FOR "-300 <= 1 - ABS(X) < "-2 WE FOUND EPS3 <= 2.2"-11.
 
 
 REFERENCES:
 
      1. ANTHONY J. STRECOK.
         ON THE CALCULATION OF THE INVERSE OF THE ERROR FUNCTION.
         MATH. OF COMP., V. 22, 1968, PP144 - 158.
 
 
 EXAMPLE OF USE:
 
     IN THE FOLLOWING PROGRAM  WE COMPUTE  THE VALUES OF INVERF(0.6) AND
     INVERF(1 - "-150):
 
     "BEGIN"
 
         "REAL" INVERF1, INVERF2;
 
         INVERSE ERROR FUNCTION(0.6, 0, INVERF1);
         INVERSE ERROR FUNCTION(1, "-150, INVERF2);
 
         OUTPUT(61,"(""("    X = ")", +D.D, "(" 1 - X = ")", +D.3D"+2ZD,
                   "(" INVERF = ")", +.5DB5DB5D"+D, /")",
                   0.6, 0.4, INVERF1);
         OUTPUT(61,"(""("    X = ")", +D.D, "(" 1 - X = ")", +D.3D"+2ZD,
                   "(" INVERF = ")", +.5DB5DB5D"+D, /")",
                   1 - "-150, "-150, INVERF2)
     "END"
 
     THIS PROGRAM DELIVERS:
 
     X = +0.6 1 - X = +4.000"  -1 INVERF = +.59511 60814 50000"+0
     X = +1.0 1 - X = +1.000"-150 INVERF = +.18490 44855 00090"+2
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 8
 
 
 
 SUBSECTION: FRESNEL.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" FRESNEL(X, C, S); "VALUE" X; "REAL" X, C, S;
     "CODE" 35027;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF C(X) AND S(X);
     C:      <VARIABLE>;
             EXIT: THE VALUE OF C(X);
     S:      <VARIABLE>;
             EXIT: THE VALUE OF S(X).
 
 
 PROCEDURES USED: FG = CP35028.
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
     SEE METHOD AND PERFORMANCE OF THE PROCEDURE FG (THIS SECTION).
 
 
 REFERENCES :
     SEE REF. [1] AND [3] OF THE PROCEDURE FG (THIS SECTION).
 
 
1SECTION : 6.7                (OCTOBER 1974)                      PAGE 9
 
 
 
 SUBSECTION: FG.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" FG(X, F, G); "VALUE" X; "REAL" X, F, G;
     "CODE" 35028;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:      <ARITHMETIC EXPRESSION>;
             ENTRY: THE (REAL) ARGUMENT OF F(X) AND G(X);
     F:      <VARIABLE>;
             EXIT: THE VALUE OF F(X);
     G:      <VARIABLE>;
             EXIT: THE VALUE OF G(X).
 
 
 PROCEDURES USED: FRESNEL = CP35027.
 
 
 RUNNING TIME: ABOUT 0.001 400 SEC.
 
 
 LANGUAGE: ALGOL 60.
 
 
 METHOD AND PERFORMANCE:
 
     IF ABS(X) <= 1.6  THE FRESNEL INTEGRALS  ARE COMPUTED WITH RATIONAL
     CHEBYSHEV  APPROXIMATIONS  AS  GIVEN  IN [3]. ON THIS  INTERVAL THE
     FUNCTIONS F AND G ARE CALCULATED BY MEANS OF THE EQUATIONS GIVEN IN
     THE BRIEF DESCRIPTION.
     IF ABS(X) > 1.6  THE FUNCTIONS F AND G  ARE COMPUTED WITH  RATIONAL
     CHEBYSHEV APPROXIMATIONS AS GIVEN IN [3]. IN THIS CASE  THE FRESNEL
     INTEGRALS ARE COMPUTED BY MEANS OF
 
         C(X) = 0.5 + F(X)SIN(PI / 2 * X * X) - G(X)COS(PI / 2 * X * X)
 
     AND
 
         S(X) = 0.5 - F(X)COS(PI / 2 * X * X) - G(X)SIN(PI / 2 * X * X).
 
     IF X < 0 WE USE THE RELATIONS
 
         C(-X) = -C(X), S(-X) = -S(X), F(-X) = -F(X) AND  G(-X) = -G(X).
 
     THE FUNCTION  VALUES  ARE COMPUTED  WITH A  RELATIVE  PRECISION  OF
     ABOUT "-14.
 
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 10
 
 
 
 REFERENCES:
 
     [1].M.ABRAMOWITZ AND I.A.STEGUN (ED.).
         HANDBOOK OF MATHEMATICAL FUNCTIONS.
         DOVER PUBLICATIONS, INC., NEW YORK, 1965.
 
     [2].W.J.CODY.
         RATIONAL CHEBYSHEV APPROXIMATIONS FOR THE ERROR FUNCTION.
         MATH. COMP. V. 23, 1969, PP631-637.
 
     [3].W.J.CODY.
         CHEBYSHEV APPROXIMATIONS FOR THE FRESNEL INTEGRALS.
         MATH. COMP. V. 22, 1968, PP450-453.
 
 
 EXAMPLE OF USE:
 
     IN THE FOLLOWING PROGRAM  WE COMPUTE THE VALUES OF C(X), S(X), F(X)
     AND G(X) FOR X = 1;
 
     "BEGIN"
 
         "REAL" C, S, F, G;
 
         FRESNEL(1, C, S);
         FG(1, F, G);
 
         OUTPUT(61, "(""("    C(1) = ")", +.5DB5D,
                    "("       S(1) = ")", +.5DB5D, /")", C, S);
         OUTPUT(61, "(""("    F(1) = ")", +.5DB5D,
                    "("       G(1) = ")", +.5DB5D")", F, G)
 
     "END"
 
     THIS PROGRAM DELIVERS:
 
     C(1) = +.77989 34004       S(1) = +.43825 91474
     F(1) = +.27989 34004       G(1) = +.06174 08526
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 11
 
 
 
 SOURCE TEXT(S) :
0"CODE" 35021;
     "PROCEDURE" ERRORFUNCTION(X, ERF, ERFC);
     "VALUE" X; "REAL" X, ERF, ERFC;
     "IF" X > 26   "THEN" "BEGIN" ERF:=  1; ERFC:= 0 "END" "ELSE"
     "IF" X < -5.5 "THEN" "BEGIN" ERF:= -1; ERFC:= 2 "END" "ELSE"
     "BEGIN" "REAL" ABSX, C, P, Q;
 
         ABSX:= ABS(X);
         "IF" ABSX <= 0.5 "THEN"
         "BEGIN" C:= X * X;         P:= ((-0.35609 84370 18154"-1  * C +
             0.69963 83488 61914"+1) * C + 0.21979 26161 82942"+2) * C +
             0.24266 79552 30532"+3;
             Q:= ((C +
             0.15082 79763 04078"+2) * C + 0.91164 90540 45149"+2) * C +
             0.21505 88758 69861"+3;
             ERF:=  X * P / Q; ERFC:= 1 - ERF
         "END" "ELSE"
         "BEGIN" ERFC:= EXP(-X * X) * NONEXPERFC(ABSX);
             ERF:= 1 - ERFC;
             "IF" X < 0 "THEN"
             "BEGIN" ERF:= -ERF; ERFC:= 2 - ERFC "END"
         "END"
     "END" ERRORFUNCTION;
         "EOP"
 
 "CODE" 35023;
     "PROCEDURE" INVERSE ERROR FUNCTION(X, ONEMINX, INVERF);
     "VALUE" X, ONEMINX; "REAL" X, ONEMINX, INVERF;
     "BEGIN" "REAL" ABSX, P, BETAX;
         "REAL" "ARRAY" A[0 : 23];
 
         ABSX:= ABS(X);
         "IF" ABSX > 0.8 "AND" ONEMINX > 0.2 "THEN" ONEMINX:= 0;
         "IF" ABSX <= 0.8 "THEN"
         "BEGIN"
             A[ 0]:= 0.99288 53766 18941; A[ 1]:= 0.12046 75161 43104;
             A[ 2]:= 0.01607 81993 42100; A[ 3]:= 0.00268 67044 37162;
             A[ 4]:= 0.00049 96347 30236; A[ 5]:= 0.00009 88982 18599;
             A[ 6]:= 0.00002 03918 12764; A[ 7]:= 0.00000 43272 71618;
             A[ 8]:= 0.00000 09380 81413; A[ 9]:= 0.00000 02067 34720;
             A[10]:= 0.00000 00461 59699; A[11]:= 0.00000 00104 16680;
             A[12]:= 0.00000 00023 71501; A[13]:= 0.00000 00005 43928;
             A[14]:= 0.00000 00001 25549; A[15]:= 0.00000 00000 29138;
             A[16]:= 0.00000 00000 06795; A[17]:= 0.00000 00000 01591;
             A[18]:= 0.00000 00000 00374; A[19]:= 0.00000 00000 00088;
             A[20]:= 0.00000 00000 00021; A[21]:= 0.00000 00000 00005;
             INVERF:= CHEPOLSUM(21, X * X / 0.32 - 1, A) * X
         "END" "ELSE"
         "IF" ONEMINX >= 25"-4 "THEN"
         "BEGIN"                                               "COMMENT"
1SECTION : 6.7                (MARCH 1977)                       PAGE 12
                                                                 ;
 
 
             A[ 0]:=  0.91215 88034 17554; A[ 1]:= -0.01626 62818 67664;
             A[ 2]:=  0.00043 35564 72949; A[ 3]:=  0.00021 44385 70074;
             A[ 4]:=  0.00000 26257 51076; A[ 5]:= -0.00000 30210 91050;
             A[ 6]:= -0.00000 00124 06062; A[ 7]:=  0.00000 00624 06609;
             A[ 8]:= -0.00000 00005 40125; A[ 9]:= -0.00000 00014 23208;
             A[10]:=  0.00000 00000 34384; A[11]:=  0.00000 00000 33584;
             A[12]:= -0.00000 00000 01458; A[13]:= -0.00000 00000 00810;
             A[14]:=  0.00000 00000 00053; A[15]:=  0.00000 00000 00020;
             BETAX:= SQRT(- LN((1 + ABSX) * ONEMINX));
             P:= -1.54881 30423 7326 * BETAX + 2.56549 01231 4782;
             P:= CHEPOLSUM(15, P, A);
             INVERF:= "IF" X < 0 "THEN" - BETAX * P "ELSE" BETAX * P
         "END" "ELSE"
         "IF" ONEMINX >= 5"-16 "THEN"
         "BEGIN"
             A[ 0]:=  0.95667 97090 20493; A[ 1]:= -0.02310 70043 09065;
             A[ 2]:= -0.00437 42360 97508; A[ 3]:= -0.00057 65034 22651;
             A[ 4]:= -0.00001 09610 22307; A[ 5]:=  0.00002 51085 47025;
             A[ 6]:=  0.00001 05623 36068; A[ 7]:=  0.00000 27544 12330;
             A[ 8]:=  0.00000 04324 84498; A[ 9]:= -0.00000 00205 30337;
             A[10]:= -0.00000 00438 91537; A[11]:= -0.00000 00176 84010;
             A[12]:= -0.00000 00039 91289; A[13]:= -0.00000 00001 86932;
             A[14]:=  0.00000 00002 72923; A[15]:=  0.00000 00001 32817;
             A[16]:=  0.00000 00000 31834; A[17]:=  0.00000 00000 01670;
             A[18]:= -0.00000 00000 02036; A[19]:= -0.00000 00000 00965;
             A[20]:= -0.00000 00000 00220; A[21]:= -0.00000 00000 00010;
             A[22]:=  0.00000 00000 00014; A[23]:=  0.00000 00000 00006;
             BETAX:= SQRT(- LN((1 + ABSX) * ONEMINX));
             P:= -0.55945 76313 29832 * BETAX + 2.28791 57162 6336;
             P:= CHEPOLSUM(23, P, A);
             INVERF:= "IF" X < 0 "THEN" - BETAX * P "ELSE" BETAX * P
         "END" "ELSE" "IF" "NOT" UNDERFLOW(ONEMINX) "THEN"
         "BEGIN"
             A[ 0]:=  0.98857 50640 66189; A[ 1]:=  0.01085 77051 84599;
             A[ 2]:= -0.00175 11651 02763; A[ 3]:=  0.00002 11969 93207;
             A[ 4]:=  0.00001 56648 71404; A[ 5]:= -0.00000 05190 41687;
             A[ 6]:= -0.00000 00371 35790; A[ 7]:=  0.00000 00012 17431;
             A[ 8]:= -0.00000 00001 76812; A[ 9]:= -0.00000 00000 11937;
             A[10]:=  0.00000 00000 00380; A[11]:= -0.00000 00000 00066;
             A[12]:= -0.00000 00000 00009;
             BETAX:= SQRT(- LN((1 + ABSX) * ONEMINX));
             P:= -9.19999 23588 3015 / SQRT(BETAX) + 2.79499 08201 2460;
             P:= CHEPOLSUM(12, P, A);
             INVERF:= "IF" X < 0 "THEN" - BETAX * P "ELSE" BETAX * P
         "END" "ELSE" INVERF:= SIGN(X) * 26
     "END" INVERSE ERROR FUNCTION
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 13
 
 
                                                                  ;
         "EOP"
0"CODE" 35022;
     "REAL" "PROCEDURE" NONEXPERFC(X); "VALUE" X; "REAL" X;
     "BEGIN" "REAL" ABSX, ERF, ERFC, C, P, Q;
 
         ABSX:= ABS(X);
         "IF" ABSX <= 0.5 "THEN"
         "BEGIN" ERRORFUNCTION(X, ERF, ERFC);
             NONEXPERFC:= EXP(X * X) * ERFC
         "END" "ELSE"
         "IF" ABSX < 4 "THEN"
         "BEGIN" C:= ABSX;      P:= ((((((-0.13686 48573 82717"-6  * C +
             0.56419 55174 78974"+0) * C + 0.72117 58250 88309"+1) * C +
             0.43162 22722 20567"+2) * C + 0.15298 92850 46940"+3) * C +
             0.33932 08167 34344"+3) * C + 0.45191 89537 11873"+3) * C +
             0.30045 92610 20162"+3;
             Q:= ((((((C +
             0.12782 72731 96294"+2) * C + 0.77000 15293 52295"+2) * C +
             0.27758 54447 43988"+3) * C + 0.63898 02644 65631"+3) * C +
             0.93135 40948 50610"+3) * C + 0.79095 09253 27898"+3) * C +
             0.30045 92609 56983"+3;
             NONEXPERFC:= "IF" X > 0 "THEN" P / Q "ELSE"
                          EXP(X * X) * 2 - P / Q
         "END" "ELSE"
         "BEGIN" C:= 1 / X / X;     P:= (((0.22319 24597 34185"-1  * C +
             0.27866 13086 09648"-0) * C + 0.22695 65935 39687"-0) * C +
             0.49473 09106 23251"-1) * C + 0.29961 07077 03542"-2;
             Q:= (((C +
             0.19873 32018 17135"+1) * C + 0.10516 75107 06793"+1) * C +
             0.19130 89261 07830"+0) * C + 0.10620 92305 28468"-1;
             C:= (C * (-P) / Q + 0.56418 95835 47756) / ABSX;
             NONEXPERFC:= "IF" X > 0 "THEN" C "ELSE" EXP(X * X) * 2 - C
         "END"
     "END" NONEXPERFC;
         "EOP"
0"CODE" 35027;
     "PROCEDURE" FRESNEL(X, C, S); "VALUE" X; "REAL" X, C, S;
     "BEGIN" "REAL" ABSX, X3, X4, A, P, Q, F, G, C1, S1;
         ABSX:= ABS(X);
         "IF" ABSX <= 1.2 "THEN"
         "BEGIN" A:= X * X; X3:= A * X; X4:= A * A;
             P:= (((5.47711 38568 2687"-6  * X4 - 5.28079 65137 2623"-4)
             * X4 + 1.76193 95254 3491"-2) * X4 - 1.99460 89882 6184"-1)
             * X4 + 1;
             Q:= (((1.18938 90142 2876"-7  * X4 + 1.55237 88527 6994"-5)
             * X4 + 1.09957 21502 5642"-3) * X4 + 4.72792 11201 0453"-2)
             * X4 + 1;
             C:= X * P / Q;
             P:= (((6.71748 46662 5141"-7  * X4 - 8.45557 28435 2777"-5)
             * X4 + 3.87782 12346 3683"-3) * X4 - 7.07489 91514 4523"-2)
             * X4 + 5.23598 77559 8299"-1;                     "COMMENT"
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 14
                                                                 ;
 
 
             Q:= (((5.95281 22767 8410"-8  * X4 + 9.62690 87593 9034"-6)
             * X4 + 8.17091 94215 2134"-4) * X4 + 4.11223 15114 2384"-2)
             * X4 + 1;
             S:= X3 * P / Q
         "END" "ELSE"
         "IF" ABSX <= 1.6 "THEN"
         "BEGIN" A:= X * X; X3:= A * X; X4:= A * A;
            P:=((((-5.68293 31012 1871"-8  * X4 + 1.02365 43505 6106"-5)
             * X4 - 6.71376 03469 4922"-4) * X4 + 1.91870 27943 1747"-2)
             * X4 - 2.07073 36033 5324"-1) * X4 + 1.00000 00000 0111"+0;
             Q:=((((4.41701 37406 5010"-10 * X4 + 8.77945 37789 2369"-8)
             * X4 + 1.01344 63086 6749"-5) * X4 + 7.88905 24505 2360"-4)
             * X4 + 3.96667 49695 2323"-2) * X4 + 1;
             C:= X * P / Q;
            P:=((((-5.76765 81559 3089"-9  * X4 + 1.28531 04374 2725"-6)
             * X4 - 1.09540 02391 1435"-4) * X4 + 4.30730 52650 4367"-3)
             * X4 - 7.37766 91401 0191"-2) * X4 + 5.23598 77559 8344"-1;
             Q:=((((2.05539 12445 8580"-10 * X4 + 5.03090 58124 6612"-8)
             * X4 + 6.87086 26571 8620"-6) * X4 + 6.18224 62019 5473"-4)
             * X4 + 3.53398 34276 7472"-2) * X4 + 1;
             S:= X3 * P / Q
         "END" "ELSE"
         "IF" ABSX < "15 "THEN"
         "BEGIN" FG(X, F, G);
             A:= X * X;
             A:= (A - ENTIER(A / 4) * 4) * 1.57079 63267 9490;
             C1:= COS(A); S1:= SIN(A);
             A:= "IF" X < 0 "THEN" -0.5 "ELSE" 0.5;
             C:=  F * S1 - G * C1 + A;
             S:= -F * C1 - G * S1 + A
         "END" "ELSE" C:= S:= SIGN(X) * 0.5
     "END" FRESNEL;
         "EOP"
0"CODE" 35028;
     "PROCEDURE" FG(X, F, G); "VALUE" X; "REAL" X, F, G;
     "BEGIN" "REAL" ABSX, C, S, C1, S1, A, XINV, X3INV, C4, P, Q;
 
         ABSX:= ABS(X);
         "IF" ABSX <= 1.6 "THEN"
         "BEGIN" FRESNEL(X, C, S);
             A:= X * X * 1.57079 63267 9490; C1:= COS(A); S1:= SIN(A);
             A:= "IF" X < 0 "THEN" -0.5 "ELSE" 0.5;
             P:= A - C; Q:= A - S;
             F:= Q * C1 - P * S1;
             G:= P * C1 + Q * S1
         "END" "ELSE"
         "IF" ABSX <= 1.9 "THEN"
         "BEGIN" XINV:= 1 / X; A:= XINV * XINV;
             X3INV:= A * XINV; C4:= A * A;                     "COMMENT"
1SECTION : 6.7                (OCTOBER 1974)                     PAGE 15
                                                                 ;
 
 
             P:= (((1.35304 23554 0388"+1  * C4 + 6.98534 26160 1021"+1)
             * C4 + 4.80340 65557 7925"+1) * C4 + 8.03588 12280 3942"+0)
             * C4 + 3.18309 26850 4906"-1;
             Q:= (((6.55630 64008 3916"+1  * C4 + 2.49561 99380 5172"+2)
             * C4 + 1.57611 00558 0123"+2) * C4 + 2.55491 61843 5795"+1)
             * C4 + 1;
             F:= XINV * P / Q;
             P:=((((2.05421 43249 8501"+1  * C4 + 1.96232 03797 1663"+2)
             * C4 + 1.99182 81867 8903"+2) * C4 + 5.31122 81348 0989"+1)
             * C4 + 4.44533 82755 0512"+0) * C4 + 1.01320 61881 0275"-1;
             Q:=((((1.01379 48339 6003"+3  * C4 + 3.48112 14785 6545"+3)
             * C4 + 2.54473 13318 1822"+3) * C4 + 5.83590 57571 6429"+2)
             * C4 + 4.53925 01967 3689"+1) * C4 + 1;
             G:= X3INV * P / Q
         "END" "ELSE"
         "IF" ABSX <= 2.4 "THEN"
         "BEGIN" XINV:= 1 / X; A:= XINV * XINV;
             X3INV:= A * XINV; C4:= A * A;
             P:=((((7.17703 24936 5140"+2  * C4 + 3.09145 16157 4430"+3)
             * C4 + 1.93007 64078 6716"+3) * C4 + 3.39837 13492 6984"+2)
             * C4 + 1.95883 94102 1969"+1) * C4 + 3.18309 88182 2017"-1;
             Q:=((((3.36121 69918 0551"+3  * C4 + 1.09334 24898 8809"+4)
             * C4 + 6.33747 15585 1144"+3) * C4 + 1.08535 06750 0650"+3)
             * C4 + 6.18427 13817 2887"+1) * C4 + 1;
             F:= XINV * P / Q;
             P:=((((3.13330 16306 8756"+2  * C4 + 1.59268 00608 5354"+3)
             * C4 + 9.08311 74952 9594"+2) * C4 + 1.40959 61791 1316"+2)
             * C4 + 7.11205 00178 9783"+0) * C4 + 1.01321 16176 1805"-1;
             Q:=((((1.15149 83237 6261"+4  * C4 + 2.41315 56721 3370"+4)
             * C4 + 1.06729 67803 0581"+4) * C4 + 1.49051 92279 7329"+3)
             * C4 + 7.17128 59693 9302"+1) * C4 + 1;
             G:= X3INV * P / Q
         "END" "ELSE"
         "BEGIN" XINV:= 1 / X; A:= XINV * XINV;
             X3INV:= A * XINV; C4:= A * A;
             P:=((((2.61294 75322 5142"+4  * C4 + 6.13547 11361 4700"+4)
             * C4 + 1.34922 02817 1857"+4) * C4 + 8.16343 40178 4375"+2)
             * C4 + 1.64797 71284 1246"+1) * C4 + 9.67546 03296 7090"-2;
             Q:=((((1.37012 36481 7226"+6  * C4 + 1.00105 47890 0791"+6)
             * C4 + 1.65946 46262 1853"+5) * C4 + 9.01827 59623 1524"+3)
             * C4 + 1.73871 69067 3649"+2) * C4 + 1;
             F:= (C4 * (-P) / Q + 0.31830 98861 83791) * XINV;
            P:=(((((1.72590 22465 4837"+6  * C4 + 6.66907 06166 8636"+6)
             * C4 + 1.77758 95083 8030"+6) * C4 + 1.35678 86781 3756"+5)
             * C4 + 3.87754 14174 6378"+3) * C4 + 4.31710 15782 3358"+1)
             * C4 + 1.53989 73381 9769"-1;
            Q:=(((((1.40622 44112 3580"+8  * C4 + 9.38695 86253 1635"+7)
             * C4 + 1.62095 60050 0232"+7) * C4 + 1.02878 69305 6688"+6)
             * C4 + 2.69183 18039 6243"+4) * C4 + 2.86733 19497 5899"+2)
             * C4 + 1;
             G:= (C4 * (-P) / Q + 0.10132 11836 42338) * X3INV
         "END"
     "END" FG;
         "EOP"
1SECTION : 6.9.1              (DECEMBER 1978)                    PAGE  1
 
 
 
 AUTHORS: M. BAKKER AND N.M. TEMME.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 780601.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THE FOLLOWING PROCEDURES:
 
     BESS J0;
         COMPUTES THE ORDINARY BESSEL FUNCTION OF THE FIRST KIND OF
         ORDER ZERO WITH ARGUMENT X;
 
     BESS J1;
         COMPUTES THE ORDINARY BESSEL FUNCTION OF THE FIRST KIND OF
         ORDER ONE WITH ARGUMENT X;
 
     BESS J;
         GENERATES AN ARRAY OF ORDINARY BESSEL FUNCTIONS OF THE FIRST
         KIND OF ORDER L (L = 0,...,N) WITH ARGUMENT X;
 
     BESS Y01;
         COMPUTES THE ORDINARY BESSEL FUNCTIONS OF THE SECOND KIND OF
         ORDERS ZERO AND ONE WITH ARGUMENT X; X > 0;
 
     BESS Y;
         GENERATES AN ARRAY OF ORDINARY BESSEL FUNCTIONS OF THE SECOND
         KIND OF ORDER L ( L = 0,...N) WITH ARGUMENT X; X> 0;
 
     BESS PQ0;
         THIS PROCEDURE IS AN AUXILIARY PROCEDURE FOR THE COMPUTATION OF
         THE ORDINARY BESSEL FUNCTIONS OF ORDER ZERO FOR LARGE VALUES OF
         THEIR ARGUMENT;
 
     BESS PQ1;
         THIS PROCEDURE IS AN AUXILIARY PROCEDURE FOR THE COMPUTATION OF
         THE ORDINARY BESSEL FUNCTIONS OF ORDER  ONE FOR LARGE VALUES OF
         THEIR ARGUMENT.
 
 
1SECTION : 6.9.1              (DECEMBER 1978)                    PAGE  2
 
 
 
 KEYWORDS:  BESSEL FUNCTION,
            ORDINARY BESSEL FUNCTION OF THE FIRST KIND,
            ORDINARY BESSEL FUNCTION OF THE SECOND KIND.
 
 
 REFERENCES:
 
     [1] ABRAMOWITZ, M., AND STEGUN, I. (EDS),
         HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND
         MATHEMATICAL TABLES. APPL. MATH. SER. 55, U.S. GOVT. PRINTING
         OFFICE, WASHINGTON, D.C. (1964).
 
     [2] C.W. CLENSHAW,
         CHEBYSHEV SERIES FOR MATHEMATICAL FUNCTIONS, NAT. PHYS. LAB.
         MATH. TABLES, VOL. 5, HER MAJESTY'S STATIONARY OFFICE,
         LONDON (1962).
 
     [3] W. GAUTSCHI,
         COMPUTATIONAL ASPECTS OF THREE TERM RECURRENCE RELATIONS,
         SIAM REVIEW, VOL. 9, 24-82 (1967).
 
 
 SUBSECTION: BESS J0.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "REAL" "PROCEDURE" BESS J0(X); "VALUE" X; "REAL" X;
     "CODE" 35160;
 
     BESS J0 DELIVERS THE ORDINARY BESSEL FUNCTION OF THE FIRST KIND OF
     ORDER ZERO WITH ARGUMENT X;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTION.
 
 
 PROCEDURES USED:
 
     BESS PQ0 = CP 35165.
 
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE  3
 
 
 
 RUNNING TIME:
 
     FOR ABS(X) <  8: LESS THAN 3 MS,
     FOR ABS(X) >= 8: LESS THAN 5 MS, ON THE CYBER 73/28.
 
 
 METHOD AND PERFORMANCE:
 
     CHEBYSHEV SERIES FROM [2].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X;
         X:= 1; OUTPUT(61,"("/,D,6B-.14D "-ZD")",
         X, BESS J0(X))
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
     1        .76519768655794" 0
 
 
 SUBSECTION: BESS J1.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" BESS J1(X); "VALUE" X; "REAL" X;
     "CODE" 35161;
 
     BESS J1 DELIVERS THE ORDINARY BESSEL FUNCTION OF THE FIRST KIND OF
     ORDER  ONE WITH ARGUMENT X;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTION.
 
 
 PROCEDURES USED:
 
     BESS PQ1 = CP 35166.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE  4
 
 
 
 RUNNING TIME:
 
     FOR ABS(X) <  8: LESS THAN 3 MS,
     FOR ABS(X) >= 8: LESS THAN 5 MS, ON THE CYBER 73/28.
 
 
 METHOD AND PERFORMANCE:
 
     CHEBYSHEV SERIES FROM [2].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X;
         X:= 1; OUTPUT(61,"("/,D,6B-.14D "-ZD")",
         X, BESS J1(X))
     "END"
 
     DELIVERS THE FOLLOWING RESULTS:
 
     1    .44005058574492" 0
 
 
 SUBSECTION: BESS J.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" BESS J(X,N,J); "VALUE" X,N;
     "INTEGER" N; "REAL" X; "ARRAY" J;
     "CODE" 35162;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF ARRAY J; N >= 0;
     J:  <ARRAY IDENTIFIER>;
         "ARRAY" J[0:N];
         EXIT: J[L] IS THE ORDINARY BESSEL FUNCTION OF THE FIRST KIND OF
               ORDER L AND ARGUMENT X.
 
 
 PROCEDURES USED: START = CP 35185;
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE  5
 
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 RUNNING TIME:
     ROUGHLY PROPORTIONAL TO THE MAXIMUM OF 1.359 * X + 72 AND N + 18.
 
 
 METHOD AND PERFORMANCE: MILLER'S ALGORITHM, SEE [3].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     THE PROGRAM
 
     "BEGIN" "REAL" X; "ARRAY" J[0:1];
         "FOR" X:= 1,5,10,25 "DO"
         "BEGIN" BESS J(X,1,J);
             OUTPUT(61,"("ZZ.D, 2(BB-.D"-ZD),/")",
             X, J[0] - BESS J0(X),J[1] - BESS J1(X))
         "END"
     "END"
 
     DELIVERS THE FOLLOWING RESULTS:
 
      1.0   .2"-13   .2"-13
      5.0  -.8"-14  -.4"-14
     10.0  -.4"-14   .4"-14
     25.0  -.1"-14  -.9"-15
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE  6
 
 
 
 SUBSECTION: BESS Y01.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS :
     "PROCEDURE" BESS Y01(X,Y0,Y1); "VALUE" X; "REAL" X,Y0,Y1;
     "CODE" 35163;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     Y0: <VARIABLE>;
         EXIT: Y0 HAS THE VALUE OF THE ORDINARY BESSEL FUNCTION OF THE
               SECOND KIND OF ORDER 0 AND ARGUMENT X;
     Y1: <VARIABLE>;
         EXIT: Y1 HAS THE VALUE OF THE ORDINARY BESSEL FUNCTION OF THE
               SECOND KIND OF ORDER 1 AND ARGUMENT X.
 
 
 PROCEDURES USED:
 
     BESS J0   = CP 35160,
     BESS J1   = CP 35161,
     BESS PQ0  = CP 35165,
     BESS PQ1  = CP 35166.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 RUNNING TIME:
 
     ABOUT 15 MS, ON THE CYBER 73/28.
 
 
 METHOD AND PERFORMANCE:
 
     CHEBYSHEV SERIES FROM [2].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X,Y0,Y1;
         X:= 1; BESS Y01(X,Y0,Y1);
         OUTPUT(61,"("/,4BD.D,2(B-.14D"-ZD)")",X,Y0,Y1)
     "END"
1SECTION : 6.9.1              (DECEMBER 1978)                    PAGE  7
 
 
 
     DELIVERS THE FOLLOWING RESULTS:
 
     1.0    .88256964215676"  -1    -.78121282130028" 0
 
 
 
 SUBSECTION: BESS Y.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS Y(X,N,Y); "VALUE" X,N;
     "INTEGER" N; "REAL" X; "ARRAY" Y;
     "CODE" 35164;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X > 0;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY Y; N >= 0;
     Y:  <ARRAY IDENTIFIER>;
         "ARRAY" Y[0:N];
         EXIT: Y[I] IS THE VALUE OF THE ORDINARY BESSEL FUNCTION OF THE
               SECOND KIND OF ORDER I (I = 0,...,N) AND ARGUMENT X.
 
 
 PROCEDURES USED:
 
     BESS Y01 = CP 35163.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 RUNNING TIME:
 
     DEPENDS ON N; SEE BESS Y01.
 
 
 METHOD AND PERFORMANCE:
 
     Y[0] AND Y[1] ARE COMPUTED BY USING BESS Y01 (CP 35163); THE
     REMAINING Y[I] ARE COMPUTED BY USING THE RECURRENCE RELATION
     Y[I+1]:= Y[I] * 2 * I/X - Y[I-1], I >= 1.
1SECTION : 6.9.1              (DECEMBER 1978)                    PAGE  8
 
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "ARRAY" Y[0:2];
         BESS Y(1,2,Y);
         OUTPUT(61,"("3(-D.13D"-ZD)")", Y[0], Y[1], Y[2])
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
      8.8256964215676"- 2 -7.8121282130028"- 1 -1.6506826068162"  0
 
 
 
 SUBSECTION: BESS PQ0.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS PQ0(X,P0,Q0); "VALUE" X; "REAL" X,P0,Q0;
     "CODE" 35165;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X > 0;
     P0: <VARIABLE>;
         EXIT: P0  CORRESPONDS WITH THE FUNCTION P(X,0) DEFINED
               IN [1,FORMULAS 9.2.5 AND 9.2.6];
     Q0: <VARIABLE>;
         EXIT: Q0  CORRESPONDS WITH THE FUNCTION Q(X,0) DEFINED
               IN [1,FORMULAS 9.2.5 AND 9.2.6].
 
 
 PROCEDURES USED:
 
     BESS J0  = CP 35160,
     BESS Y01 = CP 35163.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
     ABOUT 15 MS, ON THE CYBER 73/28.
1SECTION : 6.9.1              (DECEMBER 1978)                    PAGE  9
 
 
 
 METHOD AND PERFORMANCE:
 
     FOR X >= 8 CHEBYSHEV SERIES FROM [2],
     FOR X < 8 WITH BESS J0 AND BESS Y01.
 
 
 EXAMPLE OF USE:
 
     SEE SUBSECTION BESS PQ1.
 
 
 
 SUBSECTION: BESS PQ1.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS PQ1(X,P1,Q1); "VALUE" X; "REAL" X,P1,Q1;
     "CODE" 35166;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X > 0;
     P1: <VARIABLE>;
         EXIT: P1  CORRESPONDS WITH THE FUNCTION P(X,1) DEFINED
               IN [1,FORMULAS 9.2.5 AND 9.2.6];
     Q1: <VARIABLE>;
         EXIT: Q1  CORRESPONDS WITH THE FUNCTION Q(X,1) DEFINED
               IN [1,FORMULAS 9.2.5 AND 9.2.6].
 
 
 PROCEDURES USED:
     BESS J1  = CP 35161,
     BESS Y01 = CP 35163.
 
 
 REQUIRED CENTRAL MEMORY:
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
     ABOUT 15 MS, ON THE CYBER 73/28.
 
 
 METHOD AND PERFORMANCE:
     FOR X >= 8 CHEBYSHEV SERIES FROM [2],
     FOR X < 8 WITH BESS J1 AND BESS Y01.
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE 10
 
 
 
 EXAMPLE OF USE:
 
     FROM THE WRONSKIAN RELATION [1,9.1.16] IT CAN BE SHOWN THAT
     P0 * P1 + Q0 * Q1 = 1, WHATEVER X. IN THE FOLLOWING PROGRAM WE
     VERIFY THIS RELATION.
 
     "BEGIN" "REAL" X,P,Q,R,S;
         "FOR" X:= 1,3,5,10 "DO"
         "BEGIN" BESSPQ0(X,P,Q); BESSPQ1(X,R,S);
             OUTPUT(61,"("BB,D.2D"+3D")", ABS(P*R + Q*S -1))
         "END"
     "END"
 
     THE RESULTS ARE:
 
     4.97"-014 4.26"-014 5.68"-014 7.11"-015
 
 
 
 SOURCE TEXT(S):
 
 "CODE" 35160;
     "REAL" "PROCEDURE" BESS J0(X); "VALUE" X; "REAL" X;
     "IF" X=0 "THEN" BESS J0:= 1 "ELSE"
     "IF" ABS(X) <  8 "THEN"
     "BEGIN" "REAL" Z, Z2, AR, B0, B1, B2;
         X:= X/8; Z:= 2*X*X - 1; Z2:= Z + Z;
         B1:= B2:= 0;
         "FOR" AR:=-.75885"-15, +.4125321        "-13,
         -.194383469      "-11, +.7848696314     "-10,
         -.267925353056   "- 8, +.7608163592419  "- 7,
         -.176194690776215"- 5, +.324603288210051"- 4,
         -.46062616620628 "- 3, +.48191800694676 "- 2,
         -.34893769411409 "- 1, +.158067102332097    ,
         -.37009499387265 "- 0, +.265178613203337    ,
         -.872344235285222"- 2 "DO"
         "BEGIN" B0:= Z2*B1-B2+AR;
           B2:= B1; B1:= B0
         "END";
       BESS J0:= Z*B1 - B2 + .15772 79714 7489
     "END" "ELSE"
     "BEGIN" "REAL" C, COSX, SINX, P0, Q0;
       X:= ABS(X); C:= .79788 45608 02865 / SQRT(X);
       COSX:= COS(X-.70685 83470 57703" 1);
       SINX:= SIN(X-.70685 83470 57703" 1);
       BESS PQ0(X, P0, Q0);
       BESSJ0:= C * (P0 * COSX - Q0 * SINX)
     "END" BESS J0
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE 11
 
 
                                                                  ;
         "EOP"
 "CODE" 35161;
     "REAL" "PROCEDURE" BESS J1(X); "VALUE" X; "REAL" X;
     "IF" X=0 "THEN" BESS J1:= 0 "ELSE"
     "IF" ABS(X) < 8 "THEN"
     "BEGIN" "REAL" Z, Z2, AR, B0, B1, B2;
       X:= X/8; Z:= 2*X*X - 1; Z2:= Z + Z;
         "COMMENT" COMPUTATION OF J1;
         B1:= B2:= 0;
         "FOR" AR:=
         -.19554          "-15, +.1138572        "-13,
         -.57774042       "-12, +.2528123664     "-10,
         -.94242129816    "- 9, +.2949707007278  "- 7,
         -.76175878054003 "- 6, +.158870192399321"- 4,
         -.260444389348581"- 3, +.324027018268386"- 2,
         -.291755248061542"- 1, +.177709117239728"- 0,
         -.661443934134543"- 0, +.128799409885768"+ 1,
         -.119180116054122"+ 1 "DO"
         "BEGIN" B0:= Z2*B1-B2+AR;
           B2:= B1; B1:= B0
         "END";
       BESS J1:= X * (Z * B1 - B2 + .64835 87706 05265)
     "END" "ELSE"
     "BEGIN" "REAL" C, COSX, SINX, P1, Q1; "INTEGER" SGNX;
       SGNX:= SIGN(X); X:= ABS(X);
       C:= .79788 45608 02865 / SQRT(X);
       COSX:= COS(X-.70685 83470 57703"+1);
       SINX:= SIN(X-.70685 83470 57703"+1);
       BESS PQ1(X, P1, Q1);
       BESS J1:= SGNX * C * (P1*SINX + Q1*COSX)
     "END" BESS J1;
         "EOP"
 
 "CODE" 35162;
     "PROCEDURE" BESS J(X, N, J); "VALUE" X, N;
     "REAL"X; "INTEGER" N; "ARRAY" J;
     "IF" X=0 "THEN"
     "BEGIN" J[0]:= 1;
         "FOR" N:= N "STEP" -1 "UNTIL" 1 "DO" J[N]:= 0
     "END"
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE 12
 
 
 
     "ELSE"
     "BEGIN""REAL" X2, R, S; "INTEGER" L, M, NU, SIGNX;
         SIGNX:= SIGN(X); X:= ABS(X);
         R:= S:= 0; X2:= 2/X; L:= 0; NU:= START(X,N,0);
         "FOR" M:= NU    "STEP" -1 "UNTIL" 1 "DO"
         "BEGIN" R:= 1/(X2*M-R);
             L:= 2-L; S:= R*(L+S);
             "IF" M<=N "THEN" J[M]:= R
         "END";
         J[0]:= R:= 1/(1+S);
         "FOR" M:= 1 "STEP" 1 "UNTIL" N "DO"
         J[M]:= R:= R*J[M];
         "IF" SIGNX < 0 "THEN"
         "FOR" M:= 1 "STEP" 2 "UNTIL" N "DO"
         J[M]:= -J[M];
     "END" BESSELJ;
         "EOP"
 
 
 "CODE" 35163;
     "PROCEDURE" BESS Y01(X, Y0, Y1); "VALUE" X; "REAL" X, Y0, Y1;
     "IF" X< 8 "THEN"
     "BEGIN" "REAL" Z, Z2, C, LNX, AR, B0, B1, B2;
       C:= .63661 97723 67581; LNX:= C * LN(X);
       C:= C/X; X:= X/8; Z:= 2*X*X - 1; Z2:= Z + Z;
         "COMMENT" COMPUTATION OF Y0;
         B1:= B2:= 0;
         "FOR" AR:= +.164349 "-14,
         -.8747341        "-13, +.402633082      "-11,
         -.15837552542    "- 9, +.524879478733   "- 8,
         -.14407233274019 "- 6, +.32065325376548 "- 5,
         -.563207914105699"- 4, +.753113593257774"- 3,
         -.72879624795521 "- 2, +.471966895957634"- 1,
         -.177302012781143"- 0, +.261567346255047"- 0,
         +.179034314077182"- 0, -.274474305529745"DO"
         "BEGIN" B0:= Z2*B1-B2+AR;
           B2:= B1; B1:= B0
         "END";
       Y0:= LNX * BESS J0(8*X)+Z*B1-B2-.33146 11320 3285"-1;
         "COMMENT" COMPUTATION OF Y1;
         B1:= B2:= 0;
                                                               "COMMENT"
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE 13
                                                                 ;
 
 
         "FOR" AR:=
         +.42773          "-15, -.2440949        "-13,
         +.121143321      "-11, -.5172121473     "-10,
         +.187547032473   "- 8, -.5688440039919  "- 7,
         +.141662436449235"- 5, -.283046401495148"- 4,
         +.440478629867099"- 3, -.51316411610611 "- 2,
         +.423191803533369"- 1, -.226624991556755"- 0,
         +.675615780772188"- 0, -.767296362886646"- 0,
         -.128697384381350"- 0"DO"
         "BEGIN" B0:= Z2*B1-B2+AR;
           B2:= B1; B1:= B0
         "END";
       Y1:= LNX * BESS J1(X*8)-C + X * (Z*B1-B2+.20304 10588 593425"-1)
     "END" "ELSE"
     "BEGIN" "REAL" C, COSX, SINX, P0, Q0, P1, Q1;
       C:= .79788 45608 02865 / SQRT(X);
       BESS PQ0(X, P0, Q0); BESS PQ1(X, P1, Q1);
       X:= X-.70685 83470 57703"1; COSX:= COS(X); SINX:= SIN(X);
       Y0:= C * (P0*SINX + Q0*COSX);
       Y1:= C * (Q1*SINX - P1*COSX)
     "END" BESS Y01;
         "EOP"
 
 
 "CODE" 35164;
     "PROCEDURE" BESS Y(X, N, Y); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" Y;
     "BEGIN" "INTEGER" I; "REAL" Y0, Y1, Y2;
       BESS Y01(X, Y0, Y1); Y[0]:= Y0;
       "IF" N > 0 "THEN" Y[1]:= Y1 ;
       X:= 2/X;
       "FOR" I:=2 "STEP" 1 "UNTIL" N "DO"
       "BEGIN" Y[I]:= Y2:= (I-1)*X*Y1 - Y0;
         Y0:= Y1; Y1:= Y2
       "END"
     "END" BESS Y
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE 14
 
 
                                                                  ;
         "EOP"
 "CODE" 35165;
     "PROCEDURE" BESS PQ0(X, P0, Q0);
     "VALUE" X; "REAL" X, P0, Q0;
     "IF" X < 8 "THEN"
     "BEGIN" "REAL" B, COSX, SINX, J0X, Y0;
       B:= SQRT(X) * 1.2533 14137 31550;
       BESS Y01(X, Y0, J0X); J0X:= BESS J0(X);
       X:= X-.78539 81633 97448; COSX:= COS(X); SINX:= SIN(X);
       P0:= B * (Y0 * SINX + J0X * COSX);
       Q0:= B * (Y0 * COSX - J0X * SINX)
     "END" "ELSE"
     "BEGIN" "REAL" X2, AR, B0, B1, B2, Y;
             Y:= 8/X; X:= 2*Y*Y-1; X2:= X+X; B1:= B2:= 0;
             "FOR" AR:=
             -.10012          "-15, +.67481          "-15,
             -.506903         "-14, +.4326596        "-13,
             -.43045789       "-12, +.516826239      "-11,
             -.7864091377     "-10, +.163064646352   "- 8,
             -.5170594537606  "- 7, +.30751847875195 "- 5,
             -.536522046813212"- 3 "DO"
             "BEGIN" B0:= X2 * B1 - B2 + AR;
                B2:= B1; B1:= B0
             "END";
             P0:= X * B1 - B2 + .99946034934752;
             "COMMENT" COMPUTATION OF Q0;
             B1:= B2:= 0;
             "FOR" AR:=
             -.60999          "-15, +.425523         "-14,
             -.3336328        "-13, +.30061451       "-12,
             -.320674742      "-11, +.4220121905     "-10,
             -.72719159369    "- 9, +.1797245724797  "- 7,
             -.74144984110606 "- 6, +.683851994261165"- 4
             "DO"
             "BEGIN" B0:= X2 * B1 - B2 + AR;
                 B2:= B1; B1:= B0
             "END";
             Q0:=(X * B1 - B2 -.015555854605337) * Y
     "END" BESS PQ0
1SECTION : 6.9.1             (DECEMBER 1978)                     PAGE 15
 
 
                                                                  ;
         "EOP"
 "CODE" 35166;
     "PROCEDURE" BESS PQ1(X, P1, Q1);
     "VALUE" X; "REAL" X, P1, Q1;
     "IF" X < 8 "THEN"
     "BEGIN" "REAL" B, COSX, SINX, J1X, Y1;
       BESS Y01(X, J1X, Y1); J1X:= BESS J1(X);
       X:= X-.78539 81633 97448; COSX:= COS(X); SINX:= SIN(X);
       P1:= B * (J1X * SINX - Y1 * COSX);
       Q1:= B * (J1X * COSX + Y1 * SINX)
     "END" "ELSE"
     "BEGIN" "REAL" X2, AR, B0, B1, B2, Y;
         Y:= 8 / X; X:= 2 * Y * Y - 1; X2 := X + X;
             "COMMENT" COMPUTATION OF P1;
             B1:= B2:= 0;
             "FOR" AR:= +.10668"-15,
             -.72212          "-15, +.545267         "-14,
             -.4684224        "-13, +.46991955       "-12,
             -.570486364      "-11, +.881689866      "-10,
             -.187189074911   "- 8, +.6177633960644  "- 7,
             -.39872843004889 "- 5, +.89898983308594 "- 3
             "DO"
             "BEGIN" B0:= B1 * X2 - B2 + AR;
                 B2:= B1; B1:= B0
             "END";
             P1:= X * B1 - B2 + 1.0009030408600137;
             "COMMENT" COMPUTATION OF Q1;
             B1:= B2:= 0;
             "FOR" AR:=
             -.10269          "-15, +.65083          "-15,
             -.456125         "-14, +.3596777        "-13,
             -.32643157       "-12, +.351521879      "-11,
             -.4686363688     "-10, +.82291933277    "- 9,
             -.2095978138408  "- 7, +.91386152579555 "- 6,
             -.96277235491571 "- 4 "DO"
             "BEGIN" B0:= X2 * B1 - B2 + AR;
                 B2:= B1; B1:= B0
             "END";
             Q1:=(X * B1 - B2 + .46777787069535" -1) * Y
     "END" BESS PQ1;
         "EOP"
1SECTION : 6.9.2             (DECEMBER 1978)                     PAGE 1
 
 
 
 AUTHORS: M. BAKKER AND N.M. TEMME.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 750201.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THE FOLLOWING PROCEDURES:
 
     BESS I0;
       COMPUTES THE MODIFIED BESSEL FUNCTION OF THE FIRST KIND
       OF ORDER ZERO WITH ARGUMENT X;
 
     BESS I1;
       COMPUTES THE MODIFIED BESSEL FUNCTION OF THE FIRST KIND
       OF ORDER ONE WITH ARGUMENT X;
 
     BESS I;
       GENERATES AN ARRAY OF MODIFIED BESSEL FUNCTIONS OF THE
       FIRST KIND OF ORDER L (L = 0, ..., N) WITH ARGUMENT X;
 
     BESS K01;
       COMPUTES THE MODIFIED BESSEL FUNCTIONS OF THE THIRD KIND
       OF ORDERS ZERO AND ONE WITH ARGUMENT X; X > 0;
 
     BESS K;
       GENERATES AN ARRAY OF MODIFIED BESSEL FUNCTIONS OF THE THIRD
       KIND OF ORDER L ( L = 0, ..., N) WITH ARGUMENT X; X > 0;
 
     NONEXP BESS I0;
       DOES THE SAME AS BESS I0, BUT THE RESULT IS MULTIPLIED
       BY EXP(-ABS(X));
 
     NONEXP BESS I1;
       DOES THE SAME AS BESS I1, BUT THE RESULT IS MULTIPLIED
       BY EXP(-ABS(X));
 
     NONEXP BESS I;
       DOES THE SAME AS BESS I, BUT THE ARRAY ELEMENTS ARE
       MULTIPLIED BY EXP(-ABS(X));
 
     NONEXP BESS K01;
       DOES THE SAME AS BESS K01, BUT THE RESULTS ARE MULTIPLIED
       BY EXP(X);
1SECTION : 6.9.2              (DECEMBER 1978)                     PAGE 2
 
 
 
     NONEXP BESS K;
       DOES THE SAME AS BESS K, BUT THE ARRAY ELEMENTS ARE
       MULTIPLIED BY EXP(X).
 
 
 KEYWORDS: BESSEL FUNCTIONS,
           MODIFIED BESSEL FUNCTIONS,
           INTEGER ORDER.
 
 
 REFERENCES:
 
     [1] M.ABRAMOWITZ AND I.A. STEGUN,
         HANDBOOK OF MATHEMATICAL FUNCTIONS,
         DOVER PUBLICATIONS, INC., NEW YORK, 1968.
 
     [2] D.B.HUNTER,
         THE CALCULATION OF SOME BESSEL FUNCTIONS,
         MATHEMATICS OF COMPUTATION (1964), P. 123.
 
     [3] YUDELL LUKE,
         THE SPECIAL FUNCTIONS AND THEIR APPROXIMATIONS, VOLUME 2,
         ACADEMIC PRESS, NEW YORK AND LONDON (1969).
 
     [4] C.W.CLENSHAW,
         CHEBYSHEV SERIES FOR MATHEMATICAL FUNCTIONS,
         NAT. PHYS. LAB. MATH. TABLES, VOLUME 5,
         HER MAJESTY,S STATIONARY OFFICE, LONDON (1962).
 
     [5] W.GAUTSCHI,
         COMPUTATIONAL ASPECTS OF THREE TERM RECURRENCE RELATIONS,
         SIAM REVIEWS, VOLUME 9 (1967), P. 24.
 
     [6] J.M.BLAIR,
         RATIONAL CHEBYSHEV APPROXIMATIONS FOR THE MODIFIED
         BESSEL FUNCTIONS I0(X) AND I1(X);
         MATHEMATICS OF COMPUTATIONS,VOLUME 28,
         NR 126, APRIL 1974, P. 581-583.
 
 
 
1SECTION : 6.9.2             (DECEMBER 1978)                     PAGE 3
 
 
 
 SUBSECTION:  BESS I0.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" BESS I0(X); "VALUE" X; "REAL" X;
     "CODE" 35170;
 
     BESS I0 DELIVERS THE MODIFIED BESSEL FUNCTION OF THE
     FIRST KIND OF ORDER ZERO WITH ARGUMENT X;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTION.
 
 
 PROCEDURES USED:
 
     NONEXP BESS I0  =  CP35175.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
     FOR X = 0 BESS I0 IS ASSIGNED ITS VALUE IMMEDIATELY;
     FOR 0 < ABS(X) <= 15.0 17 MULTIPLICATIONS AND ONE DIVISION
     ARE REQUIRED;
     FOR ABS(X) > 15.0 11 MULTIPLICATIONS, 3 DIVISIONS, ONE
     EVALUATION OF THE SQUARE ROOT AND ONE EVALUATION OF THE
     EXPONENNTIAL FUNCTION ARE REQUIRED.
 
 
 METHOD AND PERFORMANCE: RATIONAL APPROXIMATION, SEE [6].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X;
         X:= 1; OUTPUT(61,"("/,D,6B-.14D"-ZD")",
         X, BESS I0(X))
     "END"
1SECTION : 6.9.2              (DECEMBER 1978)                     PAGE 4
 
 
 
     PRINTS THE FOLLOWING RESULTS:
 
     1      .12660658777520"  1
 
 
 SUBSECTION:  BESS I1.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" BESS I1(X); "VALUE" X; "REAL" X;
     "CODE" 35171;
 
     BESS I1 DELIVERS THE MODIFIED BESSEL FUNCTION OF THE
     FIRST KIND OF ORDER ONE  WITH ARGUMENT X;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTION.
 
 
 PROCEDURES USED:
 
     NONEXP BESS I1  =  CP35176.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
     FOR X = 0   BESS I1 IS ASSIGNED ITS VALUE IMMEDIATELY;
     FOR 0 < ABS(X) <= 15.0  17 MULTIPLICATIONS AND ONE DIVISION
     ARE REQUIRED;
     FOR ABS(X) > 15.0  12 MULTIPLICATIONS, 3 DIVISIONS, ONE EVALUATION
     OF THE SQUARE ROOT AND ONE EVALUATION OF THE EXPONENTIAL FUNCTION
     ARE REQUIRED.
 
 
 METHOD AND PERFORMANCE: RATIONAL APPROXIMATION, SEE [6].
1SECTION : 6.9.2              (DECEMBER 1978)                     PAGE 5
 
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X;
         X:= 1; OUTPUT(61,"("/,D,6B-.14D"-ZD")",
         X, BESS I1(X))
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
     1      .56515910399252"  0
 
 
 SUBSECTION: BESS I.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS I(X, N, I); "VALUE" X, N;
     "INTEGER" N; "REAL" X; "ARRAY" I;
     "CODE" 35172;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY I;
     I:  <ARRAY IDENTIFIER>;
         "ARRAY" I[0 : N];
         EXIT: I[L] POSSESSES THE VALUE OF THE MODIFIED BESSEL FUNCTION
         OF THE FIRST KIND OF ORDER L (0 <= L <= N).
 
 
 METHOD AND PERFORMANCE: SEE NON EXP BESS I (THIS SECTION).
 
 
 PROCEDURES USED :
 
     NONEXP BESS I  = CP 35177.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO AUXILIARY ARRAYS ARE USED.
1SECTION : 6.9.2              (DECEMBER 1978)                     PAGE 6
 
 
 
 RUNNING TIME:
 
     ROUGHLY PROPORTIONAL TO THE MAXIMUM OF
     1.359 * X + 72 AND N + 18.
 
 
 EXAMPLE OF USE : THE FOLLOWING PROGRAM CHECKS FOR X = 1 (1) 20
     THE WRONSKIAN RELATION
 
      X * (I[N - 1] * K[N] + I[N] * K[N - 1]) - 1 = 0
 
     FOR N = 1 (1) 5; THE PROGRAM READS:
 
     "BEGIN" "REAL" X; "INTEGER" N; "ARRAY" I, K[0:5];
 
         "FOR" X:= 1 "STEP" 1 "UNTIL" 20 "DO"
         "BEGIN" OUTPUT(61,"("/ZD")", X);
             BESS I(X, 5, I); BESS K(X, 5, K);
             "FOR" N:= 1, 2, 3, 4, 5 "DO"
             OUTPUT(61,"("BB-.D"-ZD")",
             X * (I[N] * K[N - 1] + I[N - 1] * K[N]) - 1)
         "END"
     "END"
 
     THE RESULTS ARE:
 
      1   .0"  0   .0"  0  -.7"-14  -.7"-14  -.7"-14
      2   .0"  0   .0"  0   .0"  0   .0"  0   .0"  0
      3   .7"-14   .7"-14   .0"  0   .0"  0   .0"  0
      4   .7"-14   .0"  0   .0"  0   .0"  0   .0"  0
      5   .0"  0   .7"-14   .7"-14   .0"  0   .0"  0
      6   .0"  0   .0"  0   .0"  0   .0"  0  -.7"-14
      7   .0"  0   .0"  0   .0"  0   .0"  0   .0"  0
      8  -.1"-13  -.1"-13  -.1"-13  -.1"-13  -.1"-13
      9   .0"  0   .0"  0   .0"  0  -.7"-14  -.7"-14
     10   .0"  0   .0"  0   .0"  0   .0"  0   .0"  0
     11   .0"  0   .0"  0   .0"  0   .0"  0   .0"  0
     12   .0"  0   .0"  0   .0"  0   .0"  0   .0"  0
     13   .7"-14   .7"-14   .0"  0   .7"-14   .0"  0
     14   .0"  0   .7"-14   .0"  0   .0"  0   .0"  0
     15   .0"  0   .0"  0   .0"  0   .0"  0   .0"  0
     16   .0"  0   .0"  0   .0"  0   .0"  0  -.7"-14
     17   .7"-14   .0"  0   .0"  0   .0"  0   .0"  0
     18   .7"-14   .0"  0   .0"  0   .0"  0  -.7"-14
     19   .7"-14   .0"  0   .0"  0   .0"  0   .0"  0
     20   .0"  0   .0"  0   .0"  0   .0"  0  -.7"-14
1SECTION : 6.9.2             (DECEMBER 1978)                     PAGE 7
 
 
 
 SUBSECTION: BESS K01.
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS K01(X, K0, K1); "VALUE" X; "REAL" X, K0, K1;
     "CODE" 35173;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     K0: <VARIABLE>;
         EXIT: K0 HAS THE VALUE OF THE MODIFIED BESSEL FUNCTION
               OF THE THIRD KIND OF ORDER 0 WITH ARGUMENT X;
     K1: <VARIABLE>;
         EXIT: K1 HAS THE VALUE OF THE MODIFIED BESSEL FUNCTION
               OF THE THIRD KIND OF ORDER ONE.
 
 
 PROCEDURES USED:
 
     NONEXP BESS K01  = CP35178
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME: DEPENDS ON THE VALUE OF X;
     THE GLOBAL VALUES IN MILLISECONDS ARE:
 
     0   < X <= 1.5    :       2.2 MS,
     1.5 < X <= 5.0    :       5.5 MS,
     5.0 < X           :       2.3 MS, ON THE CYBER 73/28.
 
 
 METHOD AND PERFORMANCE:
 
     FOR THE COMPUTATION OF K0 AND K1 THREE DIFFERENT METHODS
     ARE USED DEPENDING ON THE VALUE OF X:
     FOR 0 < X <= 1.5 K0 AND K1 ARE EVALUATED BY MEANS OF TAYLOR SERIES
     EXPANSIONS (SEE [1], P. 375, FORMULA 9.6.13);
     FOR X > 1.5 K0 AND K1 ARE COMPUTED BY MEANS OF A CALL
     OF THE CODE PROCEDURE  NONEXP BESS K01 (SEE DESCRIPTION AHEAD)
     AND MULTIPLICATION BY EXP(- X).
 
 
1SECTION : 6.9.2             (DECEMBER 1978)                     PAGE 8
 
 
 
 EXAMPLE OF USE: THE PROGRAM
 
     "BEGIN" "REAL" X, K0, K1;
         "FOR" X:= .5, 1.5, 2.5 "DO"
         "BEGIN" BESS K01(X, K0, K1);
             OUTPUT(61,"("/,4BD.D,2(B-.14D"-ZD)")",X,K0,K1)
         "END"
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
     0.5  .92441907122766"  0  .16564411200033"  1
     1.5  .21380556264754"  0  .27738780045683"  0
     2.5  .62347553200366" -1  .73890816347746" -1
 
 
 SUBSECTION: BESS K.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS K(X, N, K); "VALUE" X, N;
     "INTEGER" N; "REAL" X; "ARRAY" K;
     "CODE" 35174;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N >= 0;
     K:  <ARRAY IDENTIFIER>;
         "ARRAY" K[0 : N];
         EXIT: K[I] POSSESSES THE VALUE OF THE MODIFIED BESSEL FUNCTION
               OF THE THIRD KIND OF ORDER I (0 <= I <= N).
 
 
 PROCEDURES USED: BESS K01  =  CP 35173.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO AUXILIARY ARRAYS ARE USED.
 
 
 RUNNING TIME :
 
     DEPENDS ON THE VALUE OF X (SEE TABLE BELONGING TO BESS K01)
     AND N.
1SECTION : 6.9.2             (DECEMBER 1978)                     PAGE 9
 
 
 
 METHOD AND PERFORMANCE:
 
     K[0], ..., K[N] ARE COMPUTED ACCORDING TO THE RECURRENCE RELATION
 
         K[I + 1] = K[I - 1] + (2 * I / X) * K[I], I = 2, ..., N,
 
     (SEE [1], P. 376, FORMULA 9.6.26).
 
 
 EXAMPLE OF USE: THE PROGRAM
 
     "BEGIN" "ARRAY"  K[0 : 2]; "REAL" X;
         "FOR" X:= .5, 1.0, 1.5, 2.0 "DO"
         "BEGIN" BESS K(X, 2, K);
            OUTPUT(61,"("/D.D,3(BB.12D"-D)")",X,K)
         "END"
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
     0.5  .924419071228"0  .165644112000"1  .755018355124"1
     1.0  .421024438241"0  .601907230197"0  .162483889864"1
     1.5  .213805562648"0  .277387800457"0  .583655963257"0
     2.0  .113893872750"0  .139865881817"0  .253759754566"0
 
 
 
 SUBSECTION:  NONEXP BESS I0.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" NONEXP BESS I0(X); "VALUE" X; "REAL" X;
     "CODE" 35175;
 
     NONEXP BESS I0 DELIVERS THE MODIFIED BESSEL FUNCTION OF THE
     FIRST KIND OF ORDER 0 WITH ARGUMENT X MULTIPLIED BY EXP(-ABS(X)).
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTION.
 
 
 PROCEDURES USED:
 
     BESS I0  =  CP35170.
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 10
 
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
     FOR  X = 0 NONEXP BESS I0 IS ASSIGNED ITS VALUE IMMEDIATELY;
     FOR 0 < ABS(X) <= 15.0  18 MULTIPLICATIONS, ONE DIVISION AND
     ONE EVALUATION OF THE EXPONENTIAL FUNCTION ARE REQUIRED;
     FOR ABS(X) > 15.0  10 MULTIPLICATIONS, 3 DIVISIONS AND ONE
     EVALUATION OF THE SQUARE ROOT ARE REQUIRED.
 
 
 METHOD AND PERFORMANCE:
 
     SEE [6].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X;
         X:= 1; OUTPUT(61,"("/,D,6B-.14D"-ZD")",
         X, NONEXP BESS I0(X))
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
       1      .46575960759364"  0
 
 
 
 SUBSECTION:  NONEXP BESS I1.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "REAL" "PROCEDURE" NONEXP BESS I1(X); "VALUE" X; "REAL" X;
     "CODE" 35176;
 
     NONEXP BESS I1 DELIVERS THE MODIFIED BESSEL FUNCTION OF THE
     FIRST KIND OF ORDER 1 WITH ARGUMENT X MULTIPLIED BY EXP(-ABS(X)).
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTION.
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 11
 
 
 
 PROCEDURES USED:
 
     BESS I1  =  CP35171.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
     FOR  X = 0 NONEXP BESS I1 IS ASSIGNED ITS VALUE IMMEDIATELY;
     FOR  0 < ABS(X) <= 15.0 18 MULTIPLICATIONS, ONE DIVISION AND ONE
     EVALUATION OF THE EXPONENTIAL FUNCTION ARE REQUIRED;
     FOR  X > 15.0  11 MULTIPLICATIONS, 3 DIVISIONS AND ONE
     EVALUATION OF THE SQUARE ROOT ARE REQUIRED.
 
 
 METHOD AND PERFORMANCE:
 
     SEE [6].
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X;
         X:= 1; OUTPUT(61,"("/,D,6B-.14D"-ZD")",
         X, NONEXP BESS I1(X))
     "END"
 
     DELIVERS THE FOLLOWING RESULTS:
 
       1      .20791041534972"  0
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 12
 
 
 
 SUBSECTION: NONEXP BESS I.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" NONEXP BESS I(X, N, I); "VALUE" X, N;
     "INTEGER" N; "REAL" X; "ARRAY" I;
     "CODE" 35177;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY I; N >= 0;
     I:  <ARRAY IDENTIFIER>;
         "ARRAY" I[0:N];
         EXIT: I[L] POSSESSES THE VALUE OF THE MODIFIED
               BESSEL FUNCTION OF THE FIRST KIND OF ORDER L (L=0,..,N)
               MULTIPLIED BY EXP (- ABS(X)).
 
 
 PROCEDURES USED: START  =  CP 35185;
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO AUXILIARY ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
     ROUGHLY PROPORTIONAL TO THE MAXIMUM OF 1.359*X + 72 AND N+18.
 
 
 METHOD AND PERFORMANCE: SEE [5].
 
 
 EXAMPLE OF USE: THE PROGRAM
 
     "BEGIN" "REAL" X; "ARRAY" I[0:2];
     "FOR" X:= .5, 1.0, 1.5, 2.0, 2.5 "DO"
       "BEGIN" NONEXP BESS I(X, 2, I);
         OUTPUT(61, "("/,4BZ.D,3(B-.12D"-D)")",X,
         I[0], I[1], I[2])
       "END"
     "END"
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 13
 
 
 
     PRINTS THE FOLLOWING RESULTS:
 
      .5  .645035270449" 0  .156420803185" 0  .193520577097"-1
     1.0  .465759607594" 0  .207910415350" 0  .499387768942"-1
     1.5  .367433609054" 0  .219039387421" 0  .753810924929"-1
     2.0  .308508322554" 0  .215269289249" 0  .932390333047"-1
     2.5  .270046441612" 0  .206584649531" 0  .104778721987" 0
 
 
 
 SUBSECTION: NONEXP BESS K01.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" NONEXP BESS K01(X, K0, K1);
     "VALUE" X; "REAL" X, K0, K1;
     "CODE" 35178;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     K0: <VARIABLE>;
         EXIT: K0 HAS THE VALUE OF THE MODIFIED BESSEL FUNCTION
               OF THE THIRD KIND OF ORDER 0 WITH ARGUMENT X MULTIPLIED
               BY EXP(X);
     K1: <VARIABLE>;
         EXIT: K1 HAS THE VALUE OF THE MODIFIED BESSEL FUNCTION OF
               THE THIRD KIND OF ORDER 1 MULTIPLIED BY EXP(X).
 
 
 PROCEDURES USED:
 
     BESS K01  = CP35173.
 
 
 REQUIRED CENTRAL MEMORY:
 
     NO ARRAYS ARE USED.
 
 
 RUNNING TIME:
 
 
     DEPENDS ON THE VALUE OF X; BECAUSE OF THE STRONG
     INTERDEPENDENCE OF THE  BESS K01 ( = CP35173) AND NONEXP BESS K01
     THE READER IS REFERRED TO THE TABLE OF RUNNING TIMES BELONGING
     TO BESS K01.
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 14
 
 
 
 METHOD AND PERFORMANCE:
 
     FOR THE COMPUTATION OF K0 AND K1 THREE
     DIFFERENT METHODS ARE USED DEPENDING ON THE VALUE OF  X:
     FOR 0 < X <= 1.5 K0 AND K1 ARE COMPUTED BY MEANS OF
     MULTIPLICATION OF THE MODIFIED BESSEL FUNCTIONS OF ORDER
     ZERO AND ONE (SEE DESCRIPTION OF K0) BY EXP(X);
     FOR 1.5 < X <= 5 K0 AND K1 ARE COMPUTED BY
     THE EVALUATION OF THEIR INTEGRAL REPRESENTATIONS (SEE [1],
     P. 376, FORMULA 9.6.23) BY MEANS OF THE TRAPEZOIDAL RULE (SEE [2]);
     FOR X > 5 K0 AND K1 ARE COMPUTED BY MEANS OF
     A FINITE CHEBYSHEV SERIES EXPANSION (SEE [3], P. 339 AND [4]).
 
 
 EXAMPLE OF USE: THE PROGRAM
 
     "BEGIN" "REAL" X, K0, K1;
       "FOR" X:= .5, 1.0, 1.5, 2.0, 2.5 "DO"
       "BEGIN" NON EXP BESS K01(X, K0, K1);
         OUTPUT(61,"("/,4BZ.D,2(5B-.14D"-ZD)")",
         X, K0, K1)
       "END"
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
      .5     .15241093857739"  1     .27310097082118"  1
     1.0     .11444630798069"  1     .16361534862633"  1
     1.5     .95821005329496"  0     .12431658735525"  1
     2.0     .84156821507078"  0     .10334768470687"  1
     2.5     .75954869032810"  0     .90017442390788"  0
 
 
 SUBSECTION: NONEXP BESS K.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" NONEXP BESS K(X, N,K); "VALUE" X, N;
     "INTEGER" N; "REAL" X; "ARRAY" K;
     "CODE" 35179;
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 15
 
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N >= 0;
     K:  <ARRAY IDENTIFIER>;
         "ARRAY" K[0:N];
         EXIT: K[I] POSSESSES THE VALUE OF THE MODIFIED BESSEL
               FUNCTION OF THE THIRD KIND OF ORDER I (I = 0, ..., N)
               MULTIPLIED BY EXP(X).
 
 
 PROCEDURES USED:
 
     NONEXP BESS K01  = CP 35178.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE USED.
 
 
 METHOD AND PERFORMANCE:
     K[0] AND K[1] ARE COMPUTED BY USING NONEXP BESS K01 (CP 35178),
     WHILE K[2], ..., K[N] ARE COMPUTED ACCORDING TO THE
     RECURRENCE RELATION
     K[I+1]=K[I]+(2*I/X)*K[I], I>=2
     (SEE [1], P. 376, FORMULA 9.6.26).
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X; "ARRAY" K[0:2];
       "FOR" X:= .5, 1.0, 1.5, 2.0 "DO"
       "BEGIN" NONEXP BESS K(X, 2, K);
         OUTPUT(61, "("/,Z.D,3(5B.14D"D)")",X,K)
       "END"
     "END"
     PRINTS THE FOLLOWING RESULTS:
 
      .5  .15241093857739"1  .27310097082118"1  .12448148218621"2
     1.0  .11444630798069"1  .16361534862633"1  .44167700523334"1
     1.5  .95821005329496"0  .12431658735525"1  .26157645513649"1
     2.0  .84156821507078"0  .10334768470687"1  .18750450621395"1
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 16
 
 
 
 SOURCE TEXT(S):
 
 "CODE" 35170;
     "REAL" "PROCEDURE" BESS I0(X); "VALUE" X; "REAL" X;
     "IF" X= 0 "THEN" BESS I0:=1
     "ELSE" "IF" ABS(X) < = 15.0 "THEN"
     "BEGIN" "REAL" Z, DENOMINATOR, NUMERATOR;
       Z:= X*X; NUMERATOR:=
       (Z*(Z*(Z*(Z*(Z*(Z*(Z*
       (Z*(Z*(Z*(Z*(Z*(Z*(Z*
        .21058  07228  90567  "-22
       +.38071  52423  45326  "-19)
       +.47944  02575  48300  "-16)
       +.43512  59712  62668  "-13)
       +.30093  11271  12960  "-10)
       +.16022  46793  95361  "-07)
       +.65485  83700  96785  "-05)
       +.20259  10841  43397  "-02)
       +.46307  62847  21000  "+00)
       +.75433  73289  48189  "+02)
       +.83079  25418  09429  "+04)
       +.57166  11305  63785  "+06)
       +.21641  55723  61227  "+08)
       +.35664  44822  44025  "+09)
       +.14404  82982  27235  "+10);
       DENOMINATOR:= (Z*(Z*
       (Z-.30764  69126  82801  "04)
         +.34762  63324  05882  "07)
         -.14404  82982  27235  "10);
       BESS I0:= -NUMERATOR/DENOMINATOR;
     "END" "ELSE"
     "BEGIN"
       BESS I0:= EXP(ABS(X)) * NONEXP BESS I0(X)
     "END"
 
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 17
 
 
                                                                  ;
         "EOP"
 "CODE" 35171;
     "REAL" "PROCEDURE" BESS I1(X); "VALUE" X; "REAL" X;
     "IF" X=0 "THEN" BESS I1:=0 "ELSE"
     "IF" ABS(X) <= 15.0 "THEN"
     "BEGIN" "REAL" Z, DENOMINATOR, NUMERATOR;
       Z:= X*X;
       DENOMINATOR:=
       Z*(Z-.22258  36740  00860  "4)
         +.13629  35930  52499  "7;
       NUMERATOR:=
       (Z*(Z*(Z*(Z*(Z*(Z*(Z*
       (Z*(Z*(Z*(Z*(Z*(Z*(Z*
        .20717  57672  32792  "-26
       +.25709  19055  84414  "-23)
       +.30627  92836  56135  "-20)
       +.26137  27721  58124  "-17)
       +.17846  93614  10091  "-14)
       +.96362  88915  18450  "-12)
       +.41006  89068  47159  "-09)
       +.13545  52288  41096  "-06)
       +.33947  28903  08516  "-04)
       +.62472  61951  27003  "-02)
       +.80614  48788  21295  "-00)
       +.68210  05679  80207  "+02)
       +.34106  97522  84422  "+04)
       +.84070  57728  77836  "+05)
       +.68146  79652  62502  "+06);
       BESS I1:= X*(NUMERATOR/DENOMINATOR)
     "END" "ELSE"
     "BEGIN"
     BESS I1:= EXP(ABS(X))*NONEXP BESS I1(X)
     "END";
         "EOP"
 
 "CODE" 35172;
     "PROCEDURE" BESS I(X, N, I);
     "VALUE" X, N; "INTEGER" N; "REAL" X; "ARRAY" I;
     "IF" X = 0 "THEN"
     "BEGIN" I[0]:= 1;
         "FOR" N:= N "STEP" - 1 "UNTIL" 1 "DO" I[N]:= 0;
     "END" "ELSE"
     "BEGIN" "REAL" EXPX;
         EXPX:= EXP(ABS(X)); NONEXP BESS I(X, N, I);
         "FOR" N:= N "STEP" - 1 "UNTIL" 0 "DO"
         I[N]:= I[N] * EXPX
     "END" BESS I
 
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 18
 
 
                                                                  ;
         "EOP"
 "CODE" 35173;
     "PROCEDURE" BESS K01(X, K0, K1); "VALUE" X; "REAL" X, K0, K1;
     "IF" X <= 1.5 "THEN"
     "BEGIN" "INTEGER" K; "REAL" C, D, R, S, SUM0, SUM1, T,
         TERM, T0, T1;
         SUM0:= D:= LN(2/X) -.5772156649015328606;
         SUM1:=    C:= -1 -2    * D; R:= TERM:= 1; T:= X * X/4;
         "FOR" K:= 1,K+1 "WHILE" ABS(T0/SUM0) + ABS(T1/SUM1) >
         "-15 "DO"
         "BEGIN"  TERM:= T * TERM * R * R; D:= D + R;
             C:= C - R; R:= 1/(K+1); C:= C - R;
             T0:= TERM * D; T1:= TERM * C * R;
             SUM0:= SUM0 + T0; SUM1:= SUM1 + T1
         "END";
         K0:= SUM0; K1:= (1 + T * SUM1) / X
     "END" "ELSE"
     "BEGIN" "REAL" EXPX;
         EXPX:= EXP(- X);
         NONEXP BESS K01(X, K0, K1); K1:= EXPX * K1; K0:= K0 * EXPX
     "END" BESS K01;
         "EOP"
 
 "CODE" 35174;
     "PROCEDURE" BESS K(X, N, K); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" K;
     "BEGIN"  "INTEGER" I; "REAL" K0, K1, K2;
         BESS K01(X, K0, K1); K[0]:= K0; "IF" N > 0 "THEN" K[1]:= K1;
         X:= 2 / X;
         "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO"
         "BEGIN" K[I]:= K2:= K0 + X * (I-1)* K1;
             K0:= K1; K1:= K2
         "END"
     "END" BESS K;
         "EOP"
 
 "CODE" 35175;
     "REAL" "PROCEDURE" NONEXP BESS I0(X);
     "VALUE" X; "REAL" X;
     "IF" X= 0 "THEN"
     NONEXP BESS I0:=1 "ELSE"
     "IF" ABS(X) <= 15.0 "THEN"
     "BEGIN"
       NONEXP BESS I0:= EXP(-ABS(X))*BESS I0(X)
     "END" "ELSE"
     "BEGIN" "REAL" SQRTX, AR, BR, BR1, BR2, Z, Z2, NUMERATOR,
       DENOMINATOR;
       X:=ABS(X); SQRTX:= SQRT(X);
                                                               "COMMENT"
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 19
                                                                 ;
 
 
       BR1:= BR2:= 0; Z:= 30/X-1; Z2:= Z+Z;
       "FOR" AR:= .24392  60769  778,
       -.11559  19781  04435  "3,
       +.78403  42490  05088  "4,
       -.14346  46313  13583  "6  "DO"
       "BEGIN" BR:= Z2*BR1-BR2+AR; BR2:= BR1; BR1:= BR "END";
       NUMERATOR:= Z*BR1-BR2+.34651  98333  57379  "6;
       BR1:= BR2:= 0;
       "FOR" AR:= 1, -.32519  73333  69824  "3,
       +.20312  84361  00794  "5,
       -.36184  77792  19653  "6  "DO"
       "BEGIN" BR:= Z2*BR1 - BR2 + AR;
           BR2:= BR1; BR1:= BR
       "END";
       DENOMINATOR:= Z*BR1 - BR2 +.86566  52748  32055  "6;
       NONEXP BESS I0:= (NUMERATOR/DENOMINATOR)/SQRTX;
     "END";
         "EOP"
 
 "CODE" 35176;
     "REAL" "PROCEDURE" NONEXP BESS I1(X); "VALUE" X; "REAL" X;
     "IF" X=0 "THEN" NONEXP BESS I1:= 0
     "ELSE" "IF" ABS(X)> 15.0 "THEN"
     "BEGIN" "INTEGER" SIGNX ;
       "REAL" AR, BR, BR1, BR2, Z, Z2,
       SQRTX, DENOMINATOR, NUMERATOR;
       SIGNX:= SIGN(X); X:= ABS(X); SQRTX:= SQRT(X);
       Z:= 30/X - 1; Z2 := Z + Z;
           BR1:= BR2:= 0;
       "FOR" AR:=
       +.14940  52814  740  "+1,
       -.36202  64202  42263  "+3,
       +.22054  97222  60336  "+5,
       -.40892  80849  44275  "+6 "DO"
       "BEGIN" BR:= Z2 * BR1 - BR2 + AR;
           BR2:= BR1; BR1:= BR
       "END";
       NUMERATOR:= Z * BR1 -BR2 +.10277  66923  71524  "7;
       BR1:= BR2:= 0; "FOR" AR:= 1,
       -.63100  32005  51590  "3,
       +.49681  19495  33398  "5,
       -.10042  54281  33695  "7  "DO"
       "BEGIN" BR:= Z2 * BR1 - BR2 + AR; BR2:= BR1; BR1:=BR "END";
       DENOMINATOR:= Z * BR1 - BR2 +.26028  87678  9105  "7;
       NONEXP BESS I1:= ((NUMERATOR/DENOMINATOR)/SQRTX) * SIGN X
     "END" "ELSE"
     "BEGIN"
       NONEXP BESS I1:= EXP(-ABS(X))*BESS I1(X)
     "END"
 
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 20
 
 
                                                                  ;
         "EOP"
 "CODE" 35177;
     "PROCEDURE" NONEXP BESS I(X, N, I); "VALUE" X, N;
     "INTEGER" N; "REAL" X; "ARRAY" I;
     "IF" X = 0 "THEN"
     "BEGIN" I[0]:= 1; "FOR" N:= N "STEP" - 1 "UNTIL" 1 "DO"
         I[N]:= 0
     "END" "ELSE"
     "BEGIN" "INTEGER" K; "REAL" X2, R, S; "BOOLEAN" NEGATIVE;
         NEGATIVE:= X < 0; X:= ABS(X);
         R:= S:= 0; X2:= 2/X; K:= START(X,N,1);
         "FOR" K:= K "STEP" - 1 "UNTIL" 1 "DO"
         "BEGIN" R:= 1 / (R + X2 * K); S:= R * (2 + S);
             "IF" K <= N "THEN" I[K]:= R
         "END";
         I[0]:= R:= 1 / (1 + S);
         "IF" NEGATIVE "THEN"
         "BEGIN" "FOR" K:= 1 "STEP" 1 "UNTIL" N "DO"
             I[K]:= R:= - R * I[K]
         "END" "ELSE"
         "FOR" K:=1 "STEP" 1 "UNTIL" N "DO" I[K]:= R:= R * I[K];
     "END" NONEXP BESS I;
         "EOP"
 
 "CODE" 35178;
     "PROCEDURE" NONEXP BESS K01(X, K0, K1);"VALUE" X;"REAL" X, K0, K1;
     "IF" X <= 1.5 "THEN"
     "BEGIN" "REAL" EXPX;
         EXPX:= EXP(X); BESS K01(X, K0, K1); K0:= K0 * EXPX;
         K1:= EXPX * K1
     "END" "ELSE" "IF" X <= 5 "THEN"
     "BEGIN" "INTEGER" R; "REAL" T2, FAC, S1, S2, TERM1, TERM2,
         SQRTEXPR, EXPH2, X2;
         S1:= .5; S2:=0; R:= 0; X2:= X + X;
         EXPH2:= 1 / SQRT(5 * X);
         "FOR" FAC:= .90483741803596,
         .67032004603564,     .40656965974060,     .20189651799466,
         .82084998623899"-1,  .27323722447293"-1,  .74465830709243"-2,
         .16615572731739"-2,  .30353913807887"-3,  .45399929762485"-4,
         .55595132416500"-5,  .55739036926944"-6,  .45753387694459"-7,
         .307487987958650"-8, .16918979226151"-9,  .76218651945127"-11,
         .28111852987891"-12, .84890440338729"-14, .2098791048793"-15,
         .42483542552916"-17 "DO"
         "BEGIN" R:= R + 1; T2:= R * R / 10;
             SQRTEXPR:= SQRT(T2 / X2 + 1);
             TERM1:= FAC / SQRTEXPR; TERM2:= FAC * SQRTEXPR * T2;
             S1:= S1 + TERM1; S2:= S2 + TERM2
         "END";
                                                               "COMMENT"
1SECTION : 6.9.2              (DECEMBER 1978)                    PAGE 21
                                                                 ;
 
 
         K0:= EXPH2 * S1; K1:= EXPH2 * S2 * 2
     "END" "ELSE"
     "BEGIN" "INTEGER" R;
         "REAL" BR, BR1, BR2, CR, CR1, CR2, DR, ERMIN1, ERPLUS1, ER,
         F0, F1, EXPX, Y, Y2;
         Y:= 10 / X - 1; Y2:= Y + Y; R:= 30;
         BR1:= BR2:= CR1:= CR2:= ERPLUS1:= ER:= 0;
         "FOR" DR:= .27545" - 15, -.172697" - 14, .1136042 " - 13,
         -.7883236       " -13, .58081063       " -12,
         -.457993622     " -11, .3904375576     " -10,
         -.36454717921   " - 9, .379299645568   " - 8,
         -.450473376411  " - 7, .63257510850049 " - 6,
         -.11106685196665" - 4, .26953261276272 " - 3,
         -.11310504646928" - 1 "DO"
         "BEGIN" R:= R - 2; BR:= Y2 * BR1 - BR2 + DR;
             CR:= CR1 * Y2 - CR2 + ER;
             ERMIN1:= R * DR + ERPLUS1; ERPLUS1:= ER; ER:= ERMIN1;
             BR2:= BR1; BR1:= BR; CR2:= CR1; CR1:= CR
         "END";
         F0:= Y * BR1 - BR2 + .9884081742308258;
         F1:= Y * CR1 - CR2 + ER / 2;
         EXPX:= SQRT(1.5707963267949 / X); K0:= F0:= F0 * EXPX;
         K1:= (1 + .5 / X) * F0 + (10 / X / X) * EXPX * F1
       "END"   K0;
         "EOP"
 
 "CODE" 35179;
     "PROCEDURE" NONEXP BESS K(X, N, K); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" K;
     "BEGIN"  "INTEGER" I; "REAL" K0, K1, K2;
         NONEXP BESS K01(X, K0, K1);
         K[0]:= K0; "IF" N> 0 "THEN" K[1]:= K1; X:= 2 / X;
         "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO"
         "BEGIN" K[I]:= K2:= K0 + X * (I-1)* K1;
             K0:= K1; K1:= K2
         "END"
     "END" NONEXP BESS K;
         "EOP"
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  1
 
 
 
 AUTHORS: M.BAKKER AND N.M.TEMME.
 
 
 CONTRIBUTOR: R.MONTIJN.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 781101.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THE PROCEDURES:
 
     BESS JAPLUSN:
 
         THIS PROCEDURE CALCULATES THE BESSEL FUNCTIONS
         OF THE FIRST KIND OF ORDER A+K (0<=K<=N, 0<=A<1) AND
         ASSIGNS THEM TO AN ARRAY. THE ARGUMENT MUST BE NON-NEGATIVE.
 
     BESS YA01:
 
         THIS PROCEDURE CALCULATES THE BESSEL FUNCTIONS
         OF THE SECOND KIND (ALSO CALLED NEUMANN'S FUNCTIONS)
         OF ORDER A AND A+1 AND ARGUMENT X>0.
 
     BESS YAPLUSN:
 
         THIS PROCEDURE  GENERATES AN ARRAY OF BESSEL FUNCTIONS OF THE
         SECOND KIND OF ORDER A+N, N=0, 1, 2, ..., NMAX, AND
         ARGUMENT X>0.
         THE BESSEL FUNCTIONS OF THE SECOND KIND CORRESPOND TO THE
         FUNCTION DEFINED IN FORMULA 9.1.2 OF REFERENCE [1].
 
     BESS PQA01:
 
         THIS PROCEDURE IS AN AUXILIARY PROCEDURE FOR THE COMPUTATION OF
         THE BESSEL FUNCTIONS FOR LARGE VALUES OF THEIR ARGUMENT.
 
     BESS ZEROS:
 
         THIS PROCEDURE CALCULATES THE FIRST N ZEROS OF A BESSEL
         FUNCTION OF THE FIRST OR THE SECOND KIND OR ITS DERIVATIVE.
 
     START:
 
         THIS IS AN AUXILIARY PROCEDURE WHICH COMPUTES A STARTING VALUE
         OF AN ALGORITHM USED IN SEVERAL BESSEL FUNCTION PROCEDURES.
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  2
 
 
 
 KEYWORDS:
 
     BESSEL FUNCTION, BESSEL FUNCTION OF THE SECOND KIND, NEUMANN'S
     FUNCTION, ZEROS OF BESSEL FUNCTIONS.
 
 
 REFERENCES:
 
     [1]. ABRAMOWITZ, M., AND STEGUN, I. (EDS),
         HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND
         MATHEMATICAL TABLES.
         APPL. MATH. SER. 55, U.S. GOVT. PRINTING OFFICE,
         WASHINGTON, D.C. , 1974.
 
     [2]. GAUTSCHI, W., COMPUTATIONAL ASPECTS OF
         THREE TERM RECURRENCE RELATIONS.
         SIAM REVIEW, VOLUME 9(1967), NUMBER 1, P.24 FF.
 
     [3]. TEMME, N.M. ON THE NUMERICAL EVALUATION OF THE
         ORDINARY BESSEL FUNCTION OF THE SECOND KIND.
         J. COMP. PHYS., 21, P. 343 FF, 1976.
 
     [4]. WATSON, G.N.
         A TREATISE ON THE THEORY OF BESSEL FUNCTIONS.
         CAMBRIDGE UNIV. PRESS, LONDON AND NEW YORK, 1945.
 
     [5]. TEMME, N.M., SPECIALE FUNCTIES, IN:
         COLLOQUIUM NUMERIEKE PROGRAMMATUUR,
         J.C.P. BUS (RED.), MC SYLLABUS 29.1B,
         MATHEMATICAL CENTRE, AMSTERDAM, 1976.
 
     [6]. TEMME, N.M., AN ALGOLRITHM WITH ALGOL 60 IMPLEMENTATION
         FOR THE CALCULATION OF THE ZEROS OF A BESSEL FUNCTION,
         REPORT TW 179 MATHEMATICAL CENTRE, AMSTERDAM, 1978.
 
 
 SUBSECTION: BESS JAPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS JAPLUSN(A, X, N, JA);
     "VALUE" A, X, N;
     "INTEGER" N; "REAL" A, X; "ARRAY" JA;
     "CODE" 35180;
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  3
 
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:  < ARITHMETIC EXPRESSION > ;
         THE NONINTEGER PART OF THE ORDER; 0 <= A < 1;
     X:  < ARITHMETIC EXPRESSION >;
         THE ARGUMENT VALUE; X > = 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY JA;
     JA:  < ARRAY IDENTIFIER >;
         "ARRAY" JA[0:N];
         EXIT:  JA[K] IS ASSIGNED THE VALUE OF THE BESSEL
                FUNCTION OF THE FIRST KIND J[K+A](X),
                0 < = K < = N.
 
 
 PROCEDURES USED:
 
     BESS J        =  CP 35162,
     SPHER BESS J  =  CP 35150,
     GAMMA         =  CP 35061,
     START         =  CP 35185.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     IN ALL THE CASES THE BESSEL FUNCTIONS ARE COMPUTED
     ACCORDING TO THE MILLER METHOD DISCRIBED IN [2, P.46-52].
     THE STARTING VALUE IS COMPUTED BY THE PROCEDURE START.
 
 
 RUNNING TIME: ROUGHLY PROPORTIONAL TO THE MAXIMUM OF
     X AND N.
 
 
 EXAMPLE OF USE:
 
 
     "BEGIN" "INTEGER" N; "REAL" A, X; "ARRAY" JA[0:2];
         X:= 2; A:= .78; N:= 2;
         BESS JAPLUSN(A, X, N, JA);
         OUTPUT(61, "("/, "("X=")"D, 3B"("A=")".DD, 3B"("N=")"D,
         /, 3(3B-.14D"-ZD)")", X, A, N, JA[0], JA[1], JA[2])
     "END"
 
     RESULTS:
 
     X=2  A= .78  N=2
     .57306126928364"0  .41529475124424" 0  .16616338793111" 0
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  4
 
 
 
 SUBSECTION: BESS YA01.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS YA01(A, X, YA, YA1);
     "VALUE" A, X; "REAL" A, X, YA, YA1;
     "CODE" 35181;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0;
     YA:     <VARIABLE>;
             EXIT: THE NEUMANN FUNCTION OF ORDER A
                   AND ARGUMENT X;
     YA1:    <VARIABLE>;
             EXIT: THE NEUMANN FUNCTION OF ORDER A+1.
 
 
 PROCEDURES USED:
 
     RECIP GAMMA = CP 35060;
     BESS PQA01  = CP 35183;
     SINH        = CP 35111.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     FOR 0<X<3 THE BESSEL FUNCTIONS ARE COMPUTED BY USING TAYLOR
     SERIES. THE METHOD IS DESCRIBED IN REFERENCE [3].
     FOR X>=3 THE PROCEDURE CALLS FOR THE PROCEDURE BESS PQA01
     (SEE SUBSECTION BESS PQA01).
     THE RELATIVE ACCURACY IS ABOUT "-13, EXCEPT FOR LARGE VALUES OF X;
     IN THAT CASE THE ACCURACY MAINLY DEPENDS ON THE ACCURACY OF THE
     FUNCTIONS SIN(X) AND COS(X).
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  5
 
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
 
     "BEGIN" "REAL" P, Q;
         BESS YA01(0, 1, P, Q);
         OUTPUT(61, "("2(N)")", P, Q)
     "END"
 
     YIELDS THE FOLLOWING RESULTS
 
     +8.8256964215677"-002  -7.8121282130028"-001.
 
 
 SUBSECTION: BESS YAPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS YAPLUSN(A, X, NMAX, YAN); "VALUE" A, X, NMAX;
     "REAL" A, X; "INTEGER" NMAX; "ARRAY" YAN;
     "CODE" 35182;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X>0;
     NMAX:   <ARITHMETIC EXPRESSION>;
             THE UPPER BOUND OF THE INDICES OF THE ARRAY YAN;
     YAN:    <ARRAY IDENTIFIER>;
             "ARRAY" YAN[0:NMAX]; NMAX>=0;
             EXIT: THE VALUES OF THE BESSEL FUNCTIONS OF
                   THE SECOND KIND OF ORDER A+K, FOR THE ARGUMENT X
                   ARE ASSIGNED TO YAN[K],0<=K<=NMAX.
 
 
 PROCEDURES USED: BESS YA01 = CP 35181.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  6
 
 
 
 METHOD AND PERFORMANCE:
 
     THE RECURRENCE RELATION
 
       YAN[N+1]= -YAN[N-1] + 2*(N+A)*YAN[N]/X
 
     IS USED. THE INITIAL VALUES ARE OBTAINED FROM THE
     PROCEDURE BESS YA01. THE RECURRENCE RELATION IS NUMERICALLY
     STABLE IN THE FORWARD DIRECTION (IF A >= 0).
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
 
     "BEGIN" "ARRAY" YAN[0:2];
         BESS YAPLUSN(0, 1, 2, YAN);
         OUTPUT(61, "("3(N)")", YAN[0], YAN[1], YAN[2])
     "END"
 
     YIELDS THE FOLLOWING RESULTS
 
     +8.8256964215677"-002 -7.8121282130028"-001 -1.6506826068163"+000.
 
 
 SUBSECTION: BESS PQA01.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS PQA01(A, X, PA, QA, PA1, QA1); "VALUE" X, A;
     "REAL" X, A, PA, QA, PA1, QA1;
     "CODE" 35183;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0;
     PA:     <VARIABLE>;
             EXIT: THIS FUNCTION CORRESPONDS TO THE FUNCTION
                   P(X, A) DEFINED ON P. 205 OF REFERENCE [4].
                   SEE ALSO REFERENCE [1], FORMULA 9.2.6;
     QA:     <VARIABLE>;
             EXIT: THIS FUNCTION CORRESPONDS TO THE FUNCTION
                   Q(X, A) DEFINED ON P.205 OF REFERENCE [4].
                   SEE ALSO REFERENCE [1], FORMULA 9.2.6;
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  7
 
 
 
     PA1:    <VARIABLE>;
             EXIT: THE FUNCTION P(X, A+1);
     QA1:    <VARIABLE>;
             EXIT: THE FUNCTION Q(X, A+1).
 
 
 PROCEDURES USED:
 
     BESS JAPLUSN       =    CP35180,
     BESS YA01          =    CP35181.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     X < 3 :
     PA, QA, PA1, QA1 ARE COMPUTED FROM THE RELATIONS
 
         PA  = B * (YA0 * S + JA0 * C),
         QA  = B * (YA0 * C - JA0 * S),
 
         PA1 = B * (JA1 * S - YA1 * C),
         QA1 = B * (JA1 * C + YA1 * S),
 
     WHERE
 
           B = SQRT(HALFPI * X),
           C = COS(X - HALFPI * (A + .5)),
           S = SIN(X - HALFPI * (A + .5)),
      HALFPI = 1.57079 63267 9489,
         YA0 = Y[A](X),
         YA1 = Y[A + 1](X),
         JA0 = J[A](X),
         JA1 = J[A + 1](X);
 
     X >= 3:
     THE METHOD IS DESCRIBED IN REFERENCE [3]. IT DEPENDS ON USING
     A MILLER ALGORITHM FOR CONFLUENT HYPERGEOMETRIC FUNCTIONS.
     THE ACCURACY IS ABOUT "-13 AND IS BETTER FOR LARGE X.
     THE FUNCTIONS PA AND QA CAN ALSO BE USED FOR THE COMPUTATION
     OF THE BESSEL FUNCTION J OF THE FIRST KIND.
     SEE REFERENCE[1], FORMULA 9.2.5.
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  8
 
 
 
 EXAMPLE OF USE:
 
     FROM SOME PROPERTIES OF THE BESSEL FUNCTIONS IT CAN BE PROVED
     THAT PA*PA1+QA*QA1=1, WHATEVER X AND A. IN THE FOLLOWING PROGRAM
     WE VERIFY THIS RELATION.
 
     "BEGIN" "REAL" A, X, P, Q, R, S;
         "FOR" X:= 1, 3, 5, 10, 15, 20, 50 "DO"
         "BEGIN" BESS PQA01(0, X, P, Q, R, S);
             OUTPUT(61, "("BB, D.2D"+3D")", ABS(P*R+Q*S-1))
         "END"
     "END"
 
     THIS PROGRAM GIVES THE FOLLOWING RESULTS:
 
     1.42"-014 7.11"-015 7.11"-015 7.11"-015 1.42"-014 0.00"+000
        2.13"-014.
 
 
 SUBSECTION:  BESS ZEROS.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" BESS ZEROS(A,N,Z,D);
     "VALUE" A,N,D; "REAL" A;
     "INTEGER" N,D; "ARRAY" Z;
     "CODE" 35184;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
 
     A:     <ARITHMETIC EXPRESSION>;
            THE ORDER OF THE BESSEL FUNCTION, A>=0.
     N:     <ARITHMETIC EXPRESSION>;
            THE NUMBER OF ZEROS TO BE EVALUATED, N>=1.
     Z:     <ARRAY IDENTIFIER>;
            "ARRAY" Z[1:N];
            EXIT:  Z[J] IS THE J-TH ZERO OF THE
                   SELECTED BESSEL FUNCTON;
     D:     <ARITHMETIC EXPRESSION>;
            THE CHOICE OF D DETERMINES THE TYPE OF THE
            BESSEL FUNCTION OF WHICH THE ZEROS ARE COMPUTED:
            IF D=1 THEN JA      ,
            IF D=2 THEN YA      ,
            IF D=3 THEN JA-PRIME,
            IF D=4 THEN YA-PRIME.
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE  9
 
 
 
 PROCEDURES USED:   BESS PQA01 = CP 35183.
 
 
 REQUIRED CENTRAL MEMMORY:  NO AUXILIARY ARRAYS ARE USED.
 
 
 RUNNING TIME:  DEPENDS ON THE VALUES OF A AND N AND ON
     THE MUMBER OF ITERATIONS IN THE ALGORITHM.
     FROM TESTS IT FOLLOWS THAT FOR EACH ZERO AT MOST 3
     EVALUATIONS OF THE PROCEDURE BESS PQA01 ARE NEEDED.
 
 
 
 METHOD AND PERFORMANCE:
 
     A FIRST APPROXIMATION OF THE ZEROS OF THE SELECTED BESSEL
     FUNCTION IS CALCULATED BY MEANS OF THE ASYMPTOTIC EXPANTIONS
     ( SEE THE FORMULAS 9.5.12, 9.5.13 ( FOR A < 3 ) AND 9.5.22,
     9.5.24( FOR A >= 3 ) OF REF [1] ). THIS VALUE IS CORRECTED BY THE
     USE OF A FOURTH ORDER NEWTON-RAPHSON METHOD AS DISCRIBED ON P. 179
     OF REF [6]. MORE DETAILS CAN BE FOUND IN REF [7].
     A RELATIVE PRECISION OF 13 DIGITS IS PERSUED.
     THE COMPUTATION OF A ZERO IS TERMINATED IF THIS ACCURRACY
     IS ACHIEVED OR IF MORE THAN 5 ITERATIONS ARE NEEDED.
     THE PROCEDURE DOES NOT CHECK ON THE RANGE OF THE PARAMETERS
     A,N AND D.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" A; "INTEGER" N,D; "ARRAY" Z[1:2];
        A:=3.14; N:= 2; D:= 2;
        BESS ZEROS(A,N,Z,D);
        OUTPUT(61,"("N,/,N")",Z[1],Z[2])
     "END"
 
     PRINTS THE FIRST TWO ZEROS OF THE BESSEL FUNCTION Y OF
     THE ORDER 3.14; THE RESULT IS:
     +4.6847847078799"+000
     +8.2765898338392"+000
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 10
 
 
 
 SUBSECTION:  START.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "INTEGER" "PROCEDURE" START(X,N,T);
     "VALUE" X,N,T; "REAL" X;
     "INTEGER" N,T;
     "CODE" 35185;
 
     START:=  A STARTING VALUE FOR THE MILLER ALGORITHM
              FOR COMPUTING AN ARRAY OF BESSEL FUNCTIONS;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT OF THE BESSEL FUNCTIONS, X > 0;
     N:      <ARITHMETIC EXPRESSION>;
             THE NUMBER OF BESSEL FUNCTIONS TO BE COMPUTED, N >= 0;
     T:      <ARITHMETIC EXPRESSION>;
             THE TYPE OF BESSEL FUNCTION IN QUESTION,
             T = 0  CORRESPONDS TO ORDINARY BESSEL FUNCTIONS,
             T = 1  CORRESPONDS TO MODIFIED BESSEL FUNCTIONS.
 
 
 PROCEDURES USED:  NONE.
 
 REQUIRED CENTRAL MEMORY:  NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     THE PROCEDURE IS CALLED IN THE FOLLOWING PROCEDURES:
            BESS J                CODE  35162
            NON EXP BESS I        CODE  35177
            BESS JAPLUSN          CODE  35180
            BESS KAPLUSN          CODE  35192
            NON EXP BESS IAPLUSN  CODE  35193
            SPHER BESS J          CODE  35150
            NON EXP SPHER BESS I  CODE  35154.
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 11
 
 
 
     IN THESE PROCEDURES AN ARRAY OF BESSEL FUNCTIONS IS GENERATED
     BY USING MILLER 'S ALGORITHM (SEE REF[5]). FOR STARTING THIS
     ALGORITHM ONE NEEDS AN INTEGER NU WHICH CAN BE COMPUTED BY USING
     GAUTSCHI 'S ESTIMATES OF THE ERROR ( SEE REF[5,FORMULA (5.11)] ).
     WE COMPUTE THIS STARTING VALUE NU BY USING ASYMPTOTIC APPROXIMA-
     TIONS OF THE BESSEL FUNCTIONS, AS GIVEN IN REF[1, FORMULA 9.3.7,
     9.3.8, 9.7.7, AND 9.7.8]. GAUTSCHI USED DIFFERENT FORMULAS, BUT
     THOSE USED HERE GIVE FOR LARGE X AND N MORE REALISTIC ESTIMATES.
     THE PERSUED ACCURACY IN THE ABOVE MENTIONED PROCEDURES IS ABOUT
     "-14 . FOR OBTAINING AN ACCURACY OF "-D THE NUMBERS 36 AND 18
     APPEARING IN THE FOURTH AND SIXTH LINE OF THE SOURCE TEXT OF START
     SHOULD BE REPLACED BY (D+1)* LN(10) AND .5*(D+1)* LN(10),
     RESPECTIVELY. FOR MODIFIED BESSEL FUNCTIONS THE ACCURRACY IS IN A
     RELATIVE SENSE; FOR ORDINARY BESSEL FUNCTIONS THE ACCURRACY IS
     ABSOLUTE IF THE ORDER OF THE BESSEL FUNCTION IS SMALLER THAN X,
     OTHERWISE IT IS RELATIVE.
 
 RUNNING TIME:  NEGLECTABLE IF COMPARED WITH THE TIME NEEDED
                FOR THE BESSEL FUNCTION PROCEDURES.
 
 
 EXAMPLE OF USE:  SEE THE ABOVE MENTIONED PROCEDURES.
 
 
 
 
 SOURCE TEXT(S):
 
 "CODE" 35180;
   "PROCEDURE" BESS JAPLUSN(A, X, N, JA); "VALUE" A, X, N;
   "INTEGER" N; "REAL" X, A; "ARRAY" JA;
   "IF" X = 0 "THEN"
   "BEGIN" JA[0]:= "IF" A = 0 "THEN" 1 "ELSE" 0;
     "FOR" N:= N "STEP" -1 "UNTIL" 1 "DO" JA[N]:= 0
   "END" "ELSE"
   "IF" A = 0 "THEN"
   "BEGIN"
     BESS J(X, N, JA)
   "END" "ELSE"
   "IF" A = .5 "THEN"
   "BEGIN" "REAL" S;
     S:= SQRT(X) * .797 884 560 802 865; "COMMENT" S = SQRT(2X / PI);
     SPHER BESS J(X, N, JA);
     "FOR" N:= N "STEP" - 1 "UNTIL" 0 "DO" JA[N]:= JA[N] * S
   "END"
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 12
 
 
 
   "ELSE"
   "BEGIN" "REAL" A2, X2, R, S, L, LABDA; "INTEGER" K, M, NU;
     L:= 1; NU:= START(X,N,0);
     "FOR" M:= 1 "STEP" 1 "UNTIL" NU "DO"
     L:= L * (M+A) / (M+1); R:= S:= 0; X2:= 2 / X; K:= -1; A2:= A + A;
     "FOR" M:= NU+NU "STEP" - 1 "UNTIL" 1 "DO"
     "BEGIN" R:= 1 / (X2 * (A + M)    - R);
       "IF" K = 1 "THEN" LABDA:= 0 "ELSE"
       "BEGIN" L:= L * (M + 2) / (M + A2); LABDA:= L * (M + A) "END";
       S:= R * (LABDA + S); K:= -K;
       "IF" M<= N "THEN" JA[M]:= R
     "END";
     JA[0]:= R:= 1 / GAMMA(1 + A) / (1 + S) / X2 ** A;
     "FOR" M:= 1 "STEP" 1 "UNTIL" N "DO" JA[M]:= R:= R * JA[M];
   "END" BESS JAPLUSN;
         "EOP"
 
 
 "CODE" 35181;
   "PROCEDURE" BESS YA01(A,X,YA,YA1);"VALUE" A,X; "REAL" A,X,YA,YA1;
   "IF" A = 0 "THEN"
   "BEGIN"
     BESS Y01(X,YA,YA1)
   "END" "ELSE"
   "BEGIN" "REAL" B,C,D,E,F,G,H,P,PI,Q,R,S;"INTEGER" N,NA;
     "BOOLEAN" REC,REV;
     PI:=4*ARCTAN(1);NA:=ENTIER(A+.5);REC:=A>=.5;
     REV:=A<-.5;"IF" REV "OR" REC "THEN" A:=A-NA;
     "IF" A=-.5 "THEN"
     "BEGIN" P:=SQRT(2/PI/X);F:=P*SIN(X);G:=-P*COS(X) "END" "ELSE"
     "IF" X<3 "THEN"
     "BEGIN"
       B:=X/2;D:=-LN(B);E:=A*D;
       C:="IF" ABS(A)<"-8  "THEN" 1/PI "ELSE" A/SIN(A*PI);
       S:="IF" ABS(E)<"-8  "THEN" 1 "ELSE" SINH(E)/E;
       E:=EXP(E);G:=RECIP GAMMA(A,P,Q)*E;E:=(E+1/E)/2;
       F:=2*C*(P*E+Q*S*D);E:=A*A;
       P:=G*C;Q:=1/G/PI;C:=A*PI/2;
       R:="IF" ABS(C)<"-8  "THEN" 1 "ELSE" SIN(C)/C;R:=PI*C*R*R;
       C:=1;D:=-B*B;YA:=F+R*Q;YA1:=P;
       "FOR" N:=1,N+1 "WHILE"
       ABS(G/(1+ABS(YA)))+ABS(H/(1+ABS(YA1)))>"-15 "DO"
       "BEGIN" F:=(F*N+P+Q)/(N*N-E);C:=C*D/N;
         P:=P/(N-A);Q:=Q/(N+A);
         G:=C*(F+R*Q);H:=C*P-N*G;
         YA:=YA+G;YA1:=YA1+H;
       "END";
       F:=-YA;G:=-YA1/B
     "END"
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 13
 
 
 
     "ELSE"
     "BEGIN"
       B:=X-PI*(A+.5)/2;C:=COS(B);S:=SIN(B);
       D:=SQRT(2/X/PI);
       BESS PQA01(A,X,P,Q,B,H);
       F:=D*(P*S+Q*C);G:=D*(H*S-B*C)
     "END";
     "IF" REV "THEN"
     "BEGIN" X:=2/X;NA:=-NA-1;
       "FOR" N:=0 "STEP" 1 "UNTIL" NA "DO"
       "BEGIN" H:=X*(A-N)*F-G;G:=F;F:=H "END"
     "END" "ELSE" "IF" REC "THEN"
     "BEGIN" X:=2/X;
       "FOR" N:=1 "STEP" 1 "UNTIL" NA "DO"
       "BEGIN" H:=X*(A+N)*G-F;F:=G;G:=H "END"
     "END";
     YA:=F;YA1:=G
   "END" BESS YA01;
         "EOP"
 "CODE" 35182;
   "PROCEDURE" BESS YAPLUSN(A, X, NMAX, YAN); "VALUE" A, X, NMAX;
   "REAL" A, X; "INTEGER" NMAX; "ARRAY" YAN;
   "BEGIN" "INTEGER" N; "REAL" Y1;
     BESS YA01(A, X, YAN[0], Y1); A:= A-1; X:= 2/X;
     "IF" NMAX > 0 "THEN" YAN[1]:= Y1;
     "FOR" N:= 2 "STEP" 1 "UNTIL" NMAX "DO"
     YAN[N]:= -YAN[N-2] + (A+N)*X*YAN[N-1]
   "END" BESS YAPLUSN;
         "EOP"
 
 
 "CODE" 35183;
   "PROCEDURE" BESS PQA01(A,X,PA,QA,PA1,QA1);"VALUE" A,X;
   "REAL" A,X,PA,PA1,QA,QA1;
   "IF" A = 0 "THEN"
   "BEGIN"
     BESS PQ0(X,PA,QA); BESS PQ1(X,PA1,QA1)
   "END" "ELSE"
   "BEGIN" "INTEGER" N,NA;  "REAL" B, PI, P0, Q0 ; "BOOLEAN" REC, REV;
     PI:= 4 * ARCTAN(1);
     REV:=A<-.5;"IF" REV "THEN" A:=-A-1;
     REC:=A>=.5;"IF" REC "THEN"
     "BEGIN" NA:=ENTIER(A+.5);A:=A-NA "END";
     "IF" A=-.5 "THEN"
     "BEGIN" PA:=PA1:=1;QA:=QA1:=0 "END"
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 14
 
 
 
     "ELSE" "IF" X >= 3 "THEN"
     "BEGIN" "REAL" C,D,E,F,G,H,P,Q,R,S;
       C:=.25 - A*A; B:= X + X; F:= R:= 1; G:= -X; S:= 0;
       E:=(X*COS(A*PI)/PI*"15)**2;
       "FOR" N:=2,N+1 "WHILE" (P*P + Q*Q)*N*N<E "DO"
       "BEGIN" D:=(N-1+C/N);
         P:= (2 * N * F + B * G - D * R) / (N + 1);
         Q:= (2 * N * G - B * F - D * S) / (N + 1);
         R:= F; F:= P; S:= G; G:= Q
       "END";
       E:= F * F + G * G;
       P:= (R * F + S * G) / E;
       Q:= (S * F - R * G) / E;
       F:= P; G:= Q;
       "FOR" N:=N-1 "WHILE" N>0 "DO"
       "BEGIN" R:=(N+1)*(2-P)-2;S:=B+(N+1)*Q;D:=(N-1+C/N)/
         (R*R+S*S);P:=D*R;Q:=D*S;E:=F;
         F:=P*(E+1)-G*Q;G:=Q*(E+1)+P*G
       "END";
       F:=1+F; D:=F*F + G*G;
       PA:=F/D;QA:=-G/D;D:=A+.5-P;Q:=Q+X;
       PA1:=(PA*Q-QA*D)/X; QA1:=(QA*Q+PA*D)/X
     "END" "ELSE"
     "BEGIN" "REAL" C, S, CHI, YA, YA1; "ARRAY" JA[0:1];
       B:= SQRT(PI * X / 2);
       CHI:= X - PI * (A / 2 + .25); C:= COS(CHI); S:= SIN(CHI);
       BESS YA01(A, X, YA, YA1); BESS JAPLUSN(A, X, 1, JA);
       PA:= B * (YA * S + C * JA[0]); QA:= B * (C * YA - S * JA[0]);
       PA1:= B * (S * JA[1] - C * YA1);
       QA1:= B * (JA[1] * C + YA1 * S)
     "END";
     "IF" REC "THEN"
     "BEGIN"  X:=2/X;B:=(A+1)*X;
       "FOR" N:=1 "STEP" 1 "UNTIL" NA "DO"
       "BEGIN" P0:=PA-QA1*B; Q0:=QA+PA1*B;
         PA:=PA1;PA1:=P0; QA:=QA1; QA1:=Q0; B:=B+X
       "END"
     "END";
     "IF" REV "THEN"
     "BEGIN" P0:=PA1;PA1:=PA;PA:=P0;Q0:=QA1;QA1:=QA;QA:=Q0 "END"
   "END" BESS PQA01
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 15
 
 
                                                                  ;
         "EOP"
 "CODE" 35184;
 "PROCEDURE" BESS ZEROS(A,N,Z,D); "VALUE" A,N,D; "REAL" A;"ARRAY" Z;
                                  "INTEGER" N,D;
 "COMMENT" COMPUTES Z[1],...Z[N],THE FIRST N ZEROS OF A BESSEL FUNCTION.
    THE CHOICE OF D DETERMINES THE TYPE OF THE BESSEL FUNCTION :
    IF D=1 THEN JA       ELSE
    IF D=2 THEN YA       ELSE
    IF D=3 THEN JA-PRIME ELSE
    IF D=4 THEN YA-PRIME.
    A IS THE ORDER OF THE BESSEL FUNCTION, IT MUST BE NON-NEGATIVE.;
 "BEGIN""REAL" AA,A2,B,BB,C,CHI,CO,MU,MU2,MU3,MU4,P,PI,PA,PA1,P0,P1,PP1,
              Q,QA,QA1,Q1,QQ1,RO,SI,T,TT,U,V,W,X,XX,X4,Y; "INTEGER" J,S;
 
    "REAL" "PROCEDURE" FI(Y); "VALUE" Y; "REAL" Y;
    "COMMENT" COMPUTES FI FROM THE EQUATION
           TAN(FI)-FI=Y , WHERE Y>=0.
    THE RELATIVE ACCURACY IS AT LEAST 5 DIGITS;
    "IF" Y=0  "THEN" FI:=0         "ELSE"
    "IF" Y>"5 "THEN" FI:=1.570796  "ELSE"
    "BEGIN" "REAL" R,P,PP;
        "IF" Y<1 "THEN"
        "BEGIN" P:=(3*Y)**(1/3); PP:=P*P;
            P:=P*(1+PP*(-210+PP*(27-2*PP))/1575)
        "END" "ELSE"
        "BEGIN" P:=1/(Y+1.570796); PP:=P*P;
            P:= 1.570796-P*(1+PP*(2310+PP*(3003+PP*(4818+PP*
                    (8591+PP*16328))))/3465)
        "END";
        PP:=(Y+P)*(Y+P); R:=(P-ARCTAN(P+Y))/PP;
        FI:=P-(1+PP)*R*(1+R/(P+Y))
    "END" FI;
 
    "REAL" "PROCEDURE" R;
    "BEGIN" BESS PQA01(A,X,PA,QA,PA1,QA1);
        CHI:=X-PI*(A/2+0.25);
        SI :=SIN(CHI); CO:=COS(CHI);
        R:= "IF" D=1 "THEN" (PA*CO-QA*SI)/(PA1*SI+QA1*CO) "ELSE"
            "IF" D=2 "THEN" (PA*SI+QA*CO)/(QA1*SI-PA1*CO) "ELSE"
            "IF" D=3 "THEN" A/X-(PA1*SI+QA1*CO)/(PA*CO-QA*SI) "ELSE"
                            A/X-(QA1*SI-PA1*CO)/(PA*SI+QA*CO)
    "END" R;
                                                               "COMMENT"
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 16
                                                                 ;
 
 
    PI:=4*ARCTAN(1); AA:=A*A; MU:=4*AA; MU2:=MU*MU;
    MU3:=MU*MU2; MU4:=MU2*MU2;
    "IF" D<3 "THEN"
    "BEGIN" P:=7*MU-31; P0:=MU-1;
        P1:=4*(253*MU2-3722*MU+17869)/15/P*P0;
        Q1:=8*( 83*MU2- 982*MU+ 3779)/ 5/P
    "END" "ELSE"
    "BEGIN" P:=7*MU2+82*MU-9; P0:=MU+3;
        P1:=(4048*MU4+131264*MU3-221984*MU2-417600*MU+1012176)/60/P;
        Q1:=1.6*(83*MU3+2075*MU2-3039*MU+3537)/P
    "END";
    T:="IF" D=1"OR"D=4 "THEN" 0.25 "ELSE" 0.75; TT:=4*T;
    "IF" D<3 "THEN"
    "BEGIN" PP1:= 5/48; QQ1:= -5/36  "END" "ELSE"
    "BEGIN" PP1:=-7/48; QQ1:= 35/288 "END";
    Y:= 3*PI/8; BB:= "IF" A>=3 "THEN" A **(-2/3) "ELSE" 0.0 ;
    "FOR" S:=1 "STEP" 1 "UNTIL" N "DO"
    "BEGIN" "IF" A=0"AND"S=1"AND"D=3 "THEN"
        "BEGIN" X:=0; J:=0 "END" "ELSE"
        "BEGIN" "IF" S >= 3*A -8  "THEN"
            "BEGIN" B:=(S+A/2-T)*PI; C:=1/B/B/64;
                X:=B-1/B/8*(P0-P1*C)/(1-Q1*C)
            "END" "ELSE"
            "BEGIN" "IF" S=1 "THEN"
                "BEGIN" X:= "IF" D=1 "THEN" -2.33811 "ELSE"
                            "IF" D=2 "THEN" -1.17371 "ELSE"
                            "IF" D=3 "THEN" -1.01879 "ELSE" -2.29444
                "END" "ELSE"
                "BEGIN" X:= Y*(4*S-TT); V:= 1/X/X;
                    X:= -X**(2/3)*(1+V*(PP1+QQ1*V))
                "END";
                U:=X*BB; V:=FI(2/3*(-U)**1.5);
                W:=1/COS(V); XX:=1-W*W; C:=SQRT(U/XX);
                X:=W*(A+C/A/U*
                ("IF" D<3 "THEN" -5/48/U-C*(-5/24/XX+1/8)
                          "ELSE"  7/48/U+C*(-7/24/XX+3/8)))
            "END";  J:=0;
            L1: XX:=X*X; X4:=XX*XX; A2:=AA-XX; RO:=R; J:=J+1;
                "IF" D<3 "THEN"
                "BEGIN" U:=RO; P:=(1-4*A2)/6/X/(2*A+1);
                    Q:=(2*(XX-MU)-1-6*A)/3/X/(2*A+1)
                "END" "ELSE"
                "BEGIN" U:=-XX*RO/A2; V:=2*X*A2/(AA+XX)/3;
                    W:=A2*A2*A2;
                    Q:=V*(1+( MU2+32*MU*XX+48*X4)/32/W);
                    P:=V*(1+(-MU2+40*MU*XX+48*X4)/64/W)
                "END";
            W:=U*(1+P*RO)/(1+Q*RO); X:=X+W;
            "IF" ABS(W/X)>"-13 "AND"J<5 "THEN" "GOTO" L1
        "END"; Z[S]:=X
    "END"
 "END" BESS ZEROS
1SECTION : 6.10.1            (DECEMBER 1978)                     PAGE 17
 
 
                                                                  ;
         "EOP"
 "CODE" 35185;
 "INTEGER" "PROCEDURE" START(X,N,T); "VALUE" X,N,T; "REAL" X;
                                    "INTEGER" N,T;
 "BEGIN" "REAL"P,Q,R,Y;   "INTEGER" S;
    S:= 2*T-1; P:= 36/X-T; R:= N/X; "IF" R>1 "OR" T=1 "THEN"
    "BEGIN" Q:= SQRT(R*R+S); R:= R*LN(Q+R)-Q "END" "ELSE" R:= 0;
    Q:= 18/X+R; R:= "IF" P>Q "THEN" P "ELSE" Q;
    P:= SQRT(2*(T+R)); P:= X*((1+R)+P)/(1+P); Y:= 0;
    "FOR" Q:= Y, Y "WHILE" P>Q "OR" P<Q-1 "DO"
    "BEGIN" Y:=P; P:= P/X; Q:= SQRT(P*P+S); P:= X*(R+Q)/LN(P+Q) "END";
    START:= "IF" T=1 "THEN" ENTIER(P+1) "ELSE" -ENTIER(-P/2)*2
 "END" START;
         "EOP"
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  1
 
 
 
 AUTHORS: M.BAKKER AND N.M.TEMME.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 RECEIVED: 781101.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THE PROCEDURES:
 
     BESS IAPLUSN:
 
         THIS PROCEDURE GENERATES AN ARRAY OF MODIFIED
         BESSELFUNCTIONS OF THE FIRST KIND OF ORDER
         A+N, N=0, ..., NMAX, 0 < = A < 1 AND ARGUMENT X > = 0.
 
     NONEXP BESS IAPLUSN:
 
         THIS PROCEDURE GENERATES AN ARRAY OF MODIFIED
         BESSEL FUNCTIONS OF THE FIRST KIND OF ORDER
         A + N, N = 0, ..., NMAX, 0<=A <1 AND ARGUMENT
         X > = 0 MULTIPLIED BY THE FACTOR EXP(-X).
         THUS, APART FROM THE EXPONENTIAL FACTOR THE
         ARRAY ENTRIES ARE THE SAME AS THOSE COMPUTED
         BY BESS IAPLUSN.
 
     BESS KA01:
 
         THIS PROCEDURE CALCULATES THE MODIFIED BESSEL FUNCTIONS OF THE
         THIRD KIND OF ORDER A AND A+1, AND ARGUMENT X, X>0;
 
     BESS KAPLUSN:
 
         THIS PROCEDURE GENERATES AN ARRAY OF MODIFIED BESSEL FUNCTIONS
         OF THE THIRD KIND OF ORDER A+N, N=0, 1, ..., NMAX, AND
         ARGUMENT X>0.
         THE MODIFIED BESSEL FUNCTIONS CORRESPOND TO THE FUNCTION
         DEFINED IN FORMULA 9.6.2 OF REFERENCE[1];
 
     NONEXP BESS KA01:
 
         THIS PROCEDURE  CALCULATES THE MODIFIED BESSEL FUNCTIONS OF THE
         THIRD KIND OF ORDER A AND A + 1, AND ARGUMENT X, X > 0,
         MULTIPLIED  BY THE FACTOR EXP(X). THUS, APART FROM THE
         EXPONENTIAL FACTOR, THE  FUNCTIONS  ARE  THE  SAME AS THOSE
         COMPUTED BY BESS KA01;
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  2
 
 
 
     NONEXP BESS KAPLUSN:
 
         THIS PROCEDURE GENERATES AN ARRAY OF MODIFIED  BESSEL FUNCTIONS
         OF THE THIRD KIND OF ORDER A + N, N = 0, 1,..., NMAX, AND
         ARGUMENT X>0  MULTIPLIED BY THE FACTOR EXP(X). THUS, APART FROM
         THE  EXPONENTIAL  FACTOR, THE  FUNCTIONS  ARE THE SAME AS THOSE
         COMPUTED BY THE PROCEDURE BESS KAPLUSN.
 
 
 KEYWORDS:
 
     BESSEL FUNCTION,
     MODIFIED BESSEL FUNCTION,
     MODIFIED BESSEL FUNCTION OF THE THIRD KIND.
 
 
 REFERENCES:
 
     [1]. ABRAMOWITZ, M., AND STEGUN, I. (EDS.),
         HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND
         MATHEMATICAL TABLES.
         APPL. MATH. SER. 55, U.S. GOVT. PRINTING OFFICE,
         WASHINGTON, D.C. (1964).
 
     [2]. GAUTSCHI, W., COMPUTATIONAL ASPECTS
         OF THREE TERM RECURRENCE RELATIONS.
         SIAM REVIEW, VOLUME 9, (1967), NUMBER 1, P.24.
 
     [3]. TEMME, N.M., ON THE NUMERICAL EVALUATION OF THE
         MODIFIED BESSEL FUNCTION OF THE THIRD KIND.
         J. COMP. PHYSICS, VOL. 19, (1975), NUMBER 3, P. 324.
 
 
 SUBSECTION: BESS IAPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS IAPLUSN(A, X, N, IA);
     "VALUE" X, N, A; "REAL" X, A;
     "INTEGER" N; "ARRAY" IA;
     "CODE" 35190;
1SECTION : 6.10.2            (DECEMBER 1979)                     PAGE  3
 
 
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:  < ARITHMETIC EXPRESSION >;
         THE NONINTEGER PART OF THE ORDER OF THE
         BESSEL FUNCTIONS; 0 < = A < 1;
     X:  < ARITHMETIC EXPRESSION >;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > = 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY IA; N>= 0;
     IA: < ARRAY IDENTIFIER >;
         "ARRAY" IA[0:N]; N > = 0;
         EXIT: THE VALUES OF THE MODIFIED BESSEL FUNCTIONS
               OF THE FIRST KIND , OF ORDER A+K AND ARGUMENT X,
               I[A+K](X) ARE ASSIGNED TO THE ARRAY IA.
 
 
 PROCEDURES USED:
     NONEXP BESS IAPLUSN     =  CP 35193,
     BESS I                  =  CP 35172,
     NONEXP SPHER BESS I     =  CP 35154.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE: SEE SUBSECTION NONEXP BESS IAPLUSN.
 
 
 RUNNING TIME:
 
     ROUGHLY PROPORTIONAL TO THE MAXIMUM OF X AND N.
 
 
 EXAMPLE OF USE:
 
 
     "BEGIN" "REAL" X, A; "ARRAY" IA[0:2]  ;
         A:= .25; X:= 2;    BESS IAPLUSN(A, X, 2, IA);
         OUTPUT(61,"("2(4BD.DD),/,3(4B-.14D"-ZD)")",
         A, X, IA[0], IA[1], IA[2])
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
    0.25    2.00
     .22033544516736"  1   .13401967589829"  1   .52810850294501"  0
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  4
 
 
 
 SUBSECTION: NONEXP BESS IAPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" NONEXP BESS IAPLUSN(A, X, N, IA);
     "VALUE" A, X, N;
     "REAL" A, X; "INTEGER" N; "ARRAY" IA;
     "CODE" 35193;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:  < ARITHMETIC EXPRESSION >;
         THE NONINTEGER PART OF THE ORDER A+N, 0 < = A < 1;
     X:  < ARITHMETIC EXPRESSION >;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X >= 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY IA; N>= 0;
     IA:  < ARRAY IDENTIFIER >;
         "ARRAY" IA[0:N]; N > = 0;
         EXIT:  IA[K] HAS THE VALUE OF
                THE MODIFIED BESSEL FUNCTION OF THE FIRST KIND OF
                ORDER A + K AND ARGUMENT X MULTIPLIED BY
                EXP (-X), 0 < = K < = N.
 
 
 PROCEDURES USED:
 
     NONEXP BESS I          =  CP 35177
     NONEXP SPHER BESS I    =  CP 35154
     GAMMA                  =  CP 35061
     START                  =  CP 35185
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     IN ALL THE CASES THE BESSEL FUNCTIONS ARE COMPUTED ACCORDING TO
     THE MILLER METHOD DESCRIBED IN [2, P.46-52]. THE STARTING VALUE
     IS COMPUTED BY THE PROCEDURE START (SECTION 6.10.1).
 
 
 RUNNING TIME: ROUGHLY PROPORTIONAL TO THE MAXIMUM OF X AND N.
1SECTION : 6.10.2            (DECEMBER 1979)                     PAGE  5
 
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X, A; "ARRAY" IA[0:2];
         A:= .25; X:= 2; NON EXPBESS IAPLUSN(A, X, 2, IA);
         OUTPUT(61,"("2(4BD.DD),/,3(4B-.14D"-ZD)")",
         A, X, IA[0], IA[1], IA[2])
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
    0.25    2.00
     .29819159878790"  0   .18137590796974"  0    .71471713825726"  -1
 
 
 SUBSECTION: BESS KA01.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS KA01(A, X, KA, KA1); "VALUE" A, X;
     "REAL" A, X, KA, KA1;
     "CODE" 35191;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0;
     KA:     <VARIABLE>;
             EXIT: THE VALUE OF THE MODIFIED BESSEL FUNCTION
                   OF THE THIRD KIND OF ORDER A AND ARGUMENT X;
     KA1:    <VARIABLE>;
             EXIT: THE VALUE OF THE MODIFIED BESSEL FUNCTION OF THE
                   THIRD KIND OF ORDER A+1 AND ARGUMENT X.
 
 
 PROCEDURES USED:
 
     RECIP GAMMA         = CP 35060;
     NONEXP BESS KA01    = CP 35194;
     SINH                = CP 35111.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  6
 
 
 
 METHOD AND PERFORMANCE:
 
     FOR 0<X<1 THE BESSEL FUNCTIONS ARE COMPUTED BY USING TAYLOR
     SERIES. THE METHOD IS DESCRIBED IN REFERENCE [3]. FOR X>=1 THE
     PROCEDURE CALLS FOR THE PROCEDURE NONEXP BESS KA ( SEE SUBSECTION
     NONEXP BESS KA). THE RELATIVE ACCURACY IS ABOUT "-13, EXCEPT FOR
     LARGE VALUES OF X; IN THAT CASE THE ACCURACY ALSO DEPENDS ON THE
     RELATIVE ACCURACY OF THE EXPONENTIAL FUNCTION. IF ONE IS INTERESTED
     IN THE MODIFIED BESSEL FUNCTION OF THE THIRD KIND TIMES THE FACTOR
     EXP(X), THE PROCEDURE NONEXP BESS KA SHOULD BE USED.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
 
     "BEGIN" "REAL" P, Q;
         BESS KA01(0, 1, P, Q);
         OUTPUT(61, "("2(N)")", P, Q)
     "END"
 
     YIELDS THE FOLLOWING RESULTS
 
     +4.2102443824071"-001  +6.0190723019724"-001.
 
 
 SUBSECTION: BESS KAPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" BESS KAPLUSN(A, X, NMAX, KAN); "VALUE" A, X, NMAX;
     "INTEGER" NMAX; "REAL" A, X; "ARRAY" KAN;
     "CODE" 35192;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER. IT IS ADVISED TO TAKE A >= 0;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0;
     NMAX:   <ARITHMETIC EXPRESSION>;
             THE UPPER BOUND OF THE INDICES OF THE ARRAY KAN;
     KAN:    <ARRAY IDENTIFIER>;
             "ARRAY" KAN[0:NMAX]; NMAX>=0;
             EXIT: THE VALUE OF THE MODIFIED BESSEL FUNCTION
                   OF THE THIRD KIND OF ORDER N+A IS ASSIGNED TO KAN[N],
                   0 <= N <= NMAX.
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  7
 
 
 
 PROCEDURES USED: BESS KA01 = CP 35191.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     THE RECURRENCE RELATION KAN[N+1]=KAN[N-1]+2*(N+A)*KAN[N]/X IS USED.
     THE STARTING VALUES ARE OBTAINED FROM THE PROCEDURE BESS KA01.
     IF A>=0, RECURSION IS NUMERICALLY STABLE IN THE FORWARD DIRECTION.
     IF ONE IS INTERESTED IN THE MODIFIED BESSEL FUNCTIONS OF THE THIRD
     KIND TIMES THE FACTOR EXP(X), THE PROCEDURE NONEXP BESS KAPLUSN
     SHOULD BE USED.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
 
 
     "BEGIN" "ARRAY" KAN[0:2];
         BESS KAPLUSN(0, 1, 2, KAN);
         OUTPUT(61, "("3(N)")", KAN[0], KAN[1], KAN[2])
     "END"
 
     YIELDS THE FOLLOWING RESULTS
 
     +4.2102443824071"-001 +6.0190723019724"-001 +1.6248388986352"+000.
 
 
 SUBSECTION: NONEXP BESS KA01.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" NONEXP BESS KA01(A, X, KA, KA1);
     "VALUE" A, X; "REAL" A, X, KA, KA1;
     "CODE" 35194;
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  8
 
 
 
     THE MEANING OF THE  FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0;
     KA:     <VARIABLE>;
             EXIT: KA HAS THE VALUE OF THE MODIFIED BESSEL
                   FUNCTION OF THE THIRD KIND OF ORDER A
                   AND ARGUMENT X TIMES THE FACTOR EXP(X);
     KA1:    <VARIABLE>;
             EXIT: THE VALUE OF THE MODIFIED BESSEL FUNCTION OF THE
                   THIRD KIND OF ORDER A+1 AND ARGUMENT X TIMES THE
                   FACTOR EXP(X).
 
 
 PROCEDURES USED: BESS KA01 = CP 35191.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     FOR 0<X<1 THE PROCEDURE NONEXP BESS KA CALLS FOR THE PROCEDURE
     BESS KA01. FOR X>=1 THE BESSEL FUNCTIONS ARE COMPUTED WITH A
     MILLER ALGORITHM FOR CONFLUENT HYPERGEOMETRIC FUNCTIONS.
     THE METHOD IS DESCRIBED IN REFERENCE [3].
     FOR ALL VALUES OF X CONSIDERED (X>0) THE FUNCTIONS
     DELIVERED ARE EQUAL TO THE VALUES COMPUTED BY THE PROCEDURE
     BESS KA01, APART FROM AN EXPONENTIAL FACTOR. THE RELATION BETWEEN
     THE TWO PROCEDURES WILL BE DESCRIBED BY THE PROGRAM:
 
     "BEGIN" "REAL" A, X, KA, NEKA, KA1, NEKA1;
         "PROCEDURE" BESS KA01(A, X, KA, KA1); "CODE" 35191;
         "PROCEDURE" NONEXP BESS KA(A, X, KA, KA1); "CODE" 35194;
         A:= .3; X:= 3.14;
         BESS KA01(A, X, KA, KA1);
         NONEXP KA 01(A, X, NEKA, NEKA1)
     "END"
 
     THEN WE HAVE
 
     KA = EXP(-X)*NEKA, KA1 = EXP(-X)*NEKA1. THE RELATIVE ACCURACY IS
     ABOUT "-13.
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE  9
 
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
 
     "BEGIN" "REAL" P, Q;
         NONEXP BESS KA 01(0, 2, P, Q);
         OUTPUT(61, "("2(N)")", P, Q)
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 
     8.4156821507078"-001 +1.0334768470687"+000.
 
 
 SUBSECTION: NONEXP BESS KAPLUSN.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
 
     "PROCEDURE" NONEXP BESS KAPLUSN(A, X, NMAX, KAN);
     "VALUE" A, X, NMAX; "REAL" A, X; "INTEGER" NMAX; "ARRAY" KAN;
     "CODE" 35195;
 
     NONEXP BESS KAPLUSN GENERATES AN ARRAY OF MODIFIED BESSEL FUNCTIONS
     THE THIRD KIND OF ARGUMENT X AND ORDERS A+N, N=0, 1,..., NMAX TIMES
     THE FACTOR EXP(X).
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     A:      <ARITHMETIC EXPRESSION>;
             THE ORDER. IT IS ADVISED TO TAKE A >= 0;
     X:      <ARITHMETIC EXPRESSION>;
             THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0;
     NMAX:   <ARITHMETIC EXPRESSION>;
             THIS PARAMETER SHOULD SATISFY NMAX>=0; NMAX INDICATES THE
             MAXIMUM NUMBER OF FUNCTION VALUES TO BE GENERATED;
     KAN:    <ARRAY IDENTIFIER>;
             "ARRAY" KAN[0:NMAX]; NMAX>=0;
             EXIT: KAN[N] IS THE MODIFIED BESSEL FUNCTION OF THE THIRD
                   KIND OF ORDER N+A AND OF ARGUMENT X (N=0(1)NMAX)
                   TIMES THE FACTOR EXP(X).
 
 
 PROCEDURES USED: NONEXP BESS KA = CP 35194.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE 10
 
 
 
 METHOD AND PERFORMANCE:
 
     THE RECURRENCE RELATION KAN[N+1]=KAN[N-1]+2*(N+A)*KAN[N]/X IS USED.
     THE STARTING VALUES ARE OBTAINED FROM THE PROCEDURE NONEXP BESS KA.
     IF A>=0, RECURSION IS NUMERICALLY STABLE IN THE FORWARD DIRECTION.
     FOR ALL VALUES OF X AND NMAX CONSIDERED (X>0) THE FUNCTIONS
     DELIVERED ARE EQUAL TO THE VALUES COMPUTED BY THE PROCEDURE
     BESS KAPLUSN,APART FROM AN EXPONENTIAL FACTOR. THE RELATION BETWEEN
     THE TWO PROCEDURES WILL BE DESCRIBED BY THE PROGRAM:
 
     "BEGIN" "REAL" X, A; "ARRAY" KA, NEKA[0:10];
         "PROCEDURE" BESS KAPLUSN(A, X, NMAX, KA); "CODE" 35193;
         "PROCEDURE" NONEXP BESS KAPLUSN(A, X, NMAX, KAN); "CODE" 35195;
         X:= 2.78; A:= .96;
         BESS KAPLUSN(A, X, 10, KA);
         NONEXP BESS KAPLUSN(A, X, 10, NEKA)
     "END"
 
     THEN WE HAVE KA[N] = EXP(-X)*NEKA[N], N=0, 1, ..., 10.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM:
 
     "BEGIN" "ARRAY" KAN[0:2];
          NONEXP BESS KAPLUSN(0, 5, 2, KAN);
          OUTPUT(61, "("3(N)")", KAN[0], KAN[1], KAN[2])
     "END"
 
     YIELDS THE FOLLOWING RESULTS:
 
     +5.4780756431352"-001 +6.0027385878831"-001 +7.8791710782884"-001.
1SECTION : 6.10.2            (DECEMBER 1979)                     PAGE 11
 
 
 
 SOURCE TEXT(S):
 
 "CODE" 35190;
   "COMMENT" COMPUTATION OF I[A](X),   , I[N+A](X);
   "PROCEDURE" BESS IAPLUSN(A, X, N, IA); "VALUE" A, X, N;
   "INTEGER" N; "REAL" X, A; "ARRAY" IA;
   "IF" X= 0 "THEN"
   "BEGIN" IA[0]:= "IF" A= 0 "THEN" 1 "ELSE" 0;
     "FOR" N:= N "STEP" -1 "UNTIL" 1 "DO" IA[N]:= 0
   "END" "ELSE" "IF" A= 0 "THEN"
   "BEGIN"
     BESS I(X, N, IA);
   "END" "ELSE" "IF" A= .5 "THEN"
   "BEGIN" "REAL" C;
     C:= .797 884 560 802 865 * SQRT(ABS(X)) * EXP (ABS (X));
     NONEXP SPHER BESSI(X, N, IA);
     "FOR" N:= N "STEP" -1 "UNTIL" 0 "DO" IA[N]:= C*IA[N]
   "END" "ELSE"
   "BEGIN" "REAL" EXPX;
     EXPX:= EXP(ABS(X));
     NONEXP BESS IAPLUSN(A, X, N, IA);
     "FOR" N:= N "STEP" -1 "UNTIL" 0 "DO" IA[N]:= EXPX * IA[N]
   "END" BESS IAPLUSN;
         "EOP"
 
 "CODE" 35191;
   "PROCEDURE"  BESS KA01(A, X, KA, KA1); "VALUE" A, X;
   "REAL" A, X, KA, KA1;
   "IF" A = 0 "THEN"
   "BEGIN"
     BESS K01(X,KA,KA1)
   "END" "ELSE"
   "BEGIN" "REAL" F, G, H, PI; "INTEGER" N, NA; "BOOLEAN" REC, REV;
     PI:= 4 * ARCTAN(1);
     REV:= A < -.5; "IF" REV "THEN" A:= -A-1;
     REC:= A >=  .5; "IF" REC "THEN"
     "BEGIN" NA:=ENTIER(A+.5); A:= A - NA "END";
     "IF" A = .5 "THEN" F:= G:= SQRT(PI / X / 2) * EXP (-X) "ELSE"
     "IF" X < 1 "THEN"
     "BEGIN"                                                   "COMMENT"
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE 12
                                                                 ;
 
 
     "REAL" A1, B, C, D, E, P, Q, S;
       B:=X/2;D:=-LN(B);E:=A*D;C:=A*PI;
       C:="IF" ABS(C)<"-15 "THEN" 1 "ELSE" C/SIN(C);
       S:="IF" ABS(E)<"-15 "THEN" 1 "ELSE" SINH(E)/E;
       E:=EXP(E);A1:=(E+1/E)/2;G:=RECIP GAMMA(A,P,Q)*E;
       KA:=F:=C*(P*A1+Q*S*D);E:=A*A;
       P:=.5*G*C;Q:=.5/G;C:=1;D:=B*B;KA1:=P;
       "FOR" N:=1,N+1 "WHILE" H/KA+ABS(G)/KA1>"-15 "DO"
       "BEGIN" F:=(F*N+P+Q)/(N*N-E);C:=C*D/N;
         P:=P/(N-A);Q:=Q/(N+A);G:=C*(P-N*F);
         H:=C*F;KA:=KA+H;KA1:=KA1+G
       "END";
       F:=KA;G:=KA1/B
     "END" "ELSE"
     "BEGIN" "REAL" EXPON;
       EXPON:= EXP(-X); NONEXP BESS KA01(A, X, KA, KA1);
       F:= EXPON * KA; G:= EXPON * KA1
     "END";
     "IF" REC "THEN"
     "BEGIN" X:= 2 / X;
       "FOR" N:= 1 "STEP" 1 "UNTIL" NA "DO"
       "BEGIN" H:= F + (A + N) * X * G; F:= G; G:= H "END"
     "END";
     "IF" REV "THEN" "BEGIN" KA1:= F; KA:= G "END" "ELSE"
     "BEGIN" KA:= F; KA1:= G "END"
   "END" BESS KA01;
         "EOP"
 
 "CODE" 35192;
   "PROCEDURE" BESS KAPLUSN(A, X, NMAX, KAN); "VALUE" A, X, NMAX;
   "REAL" A, X; "INTEGER" NMAX; "ARRAY" KAN;
   "BEGIN" "INTEGER" N; "REAL" K1;
     BESS KA01(A, X, KAN[0], K1); A:= A-1; X:= 2/X;
     "IF" NMAX > 0 "THEN" KAN[1]:= K1;
     "FOR" N:= 2 "STEP" 1 "UNTIL" NMAX "DO"
     KAN[N]:= KAN[N-2] + (A+N) * X * KAN[N-1]
   "END" BESS KAPLUSN
1SECTION : 6.10.2            (DECEMBER 1979)                     PAGE 13
 
 
                                                                  ;
         "EOP"
 "CODE" 35193;
   "COMMENT" COMPUTATION OF NONEXPONENTIAL MODIFIED BESSEL
   FUNCTIONS OF FRACTIONAL ORDER;
   "PROCEDURE" NONEXP BESS IAPLUSN(A, X, N, IA); "VALUE" A, X, N;
   "REAL" X, A; "INTEGER" N; "ARRAY" IA;
   "IF" X= 0 "THEN"
   "BEGIN" IA[0]:= "IF" A= 0 "THEN" 1 "ELSE" 0;
     "FOR" N:= N "STEP" -1 "UNTIL" 1 "DO" IA[N]:= 0 "END"
   "ELSE" "IF" A= 0 "THEN"
   "BEGIN"
     NONEXP BESSI(X, N, IA)
   "END" "ELSE" "IF" A= .5 "THEN"
   "BEGIN" "REAL" C;
     C:= .797 884 560 802 865 * SQRT(X);
     NONEXP SPHER BESSI(X, N, IA);
     "FOR" N:= N "STEP" -1 "UNTIL" 0 "DO" IA[N]:= C * IA[N]
   "END" "ELSE"
   "BEGIN" "INTEGER" M, NU; "REAL" R, S, LABDA, L, A2, X2;
     A2:= A+A; X2:= 2/X; L:=1;
     NU:= START(X,N,1) ; R:= S:= 0;
     "FOR" M:= 1 "STEP" 1 "UNTIL" NU "DO" L:= L * (M+A2)/(M+1);
     "FOR" M:= NU "STEP" -1 "UNTIL" 1 "DO"
     "BEGIN" R:= 1/(X2 *(A+M)+R); L:= L*(M+1)/(M+A2);
       LABDA:= L*(M+A) * 2; S:= R * (LABDA + S);
       "IF" M  <=  N "THEN" IA[M]:= R
     "END";
     IA[0]:= R:= 1/(1+S)/GAMMA(1+A)/X2 **A;
     "FOR" M:= 1 "STEP" 1 "UNTIL" N "DO" IA[M]:= R:= IA[M] * R;
   "END";
         "EOP"
 
 "CODE" 35194;
   "PROCEDURE" NONEXP BESS KA01(A, X, KA, KA1); "VALUE" A, X;
   "REAL" A, X, KA, KA1;
   "IF" A = 0 "THEN"
   "BEGIN"
     NONEXP BESS K01(X,KA,KA1)
   "END" "ELSE"
   "BEGIN" "REAL" F, G, H, PI; "INTEGER" N, NA; "BOOLEAN" REC, REV;
     PI:= 4 * ARCTAN(1);
     REV:= A < -.5; "IF" REV "THEN" A:= -A-1;
     REC:= A >=  .5; "IF" REC "THEN"
     "BEGIN" NA:=ENTIER(A+.5); A:= A - NA "END";
     "IF" A = -.5 "THEN" F:= G:= SQRT(PI / X / 2) "ELSE"
     "IF" X < 1 "THEN"
     "BEGIN"                                                   "COMMENT"
1SECTION : 6.10.2            (DECEMBER 1978)                     PAGE 14
                                                                 ;
 
 
       "REAL" EXPON;
       EXPON:= EXP(X); BESS KA01(A, X, KA, KA1);
       F:= EXPON * KA; G:= EXPON * KA1
     "END" "ELSE"
     "BEGIN" "REAL" B, C, E, P, Q;
       C:=.25-A*A;B:=X+X;G:=1;F:=0;E:=COS(A*PI)/PI*X*"15;
       "FOR" N:=1,N+1 "WHILE" H*N<E "DO"
       "BEGIN" H:=(2*(N+X)*G-(N-1+C/N)*F)/(N+1);F:=G;
           G:=H
       "END";
       P:= Q:= F / G; E:= B - 2;
       "FOR" N:=N,N-1 "WHILE" N>0 "DO"
       "BEGIN" P:=(N-1+C/N)/(E+(N+1)*(2-P));Q:=P*(1+Q) "END";
       F:=SQRT(PI/B)/(1+Q);G:=F*(A+X+.5-P)/X
     "END";
     "IF" REC "THEN"
     "BEGIN" X:= 2 / X;
       "FOR" N:= 1 "STEP" 1 "UNTIL" NA "DO"
       "BEGIN" H:= F + (A + N) * X * G; F:= G; G:= H "END"
     "END";
     "IF" REV "THEN" "BEGIN" KA1:= F; KA:= G "END" "ELSE"
     "BEGIN" KA:= F; KA1:= G "END"
   "END" NONEXP BESS KA01;
         "EOP"
 
 "CODE" 35195;
   "PROCEDURE" NONEXP BESS KAPLUSN(A, X, NMAX, KAN);
   "VALUE" A, X, NMAX;
   "REAL" A, X; "INTEGER" NMAX; "ARRAY" KAN;
   "BEGIN" "INTEGER" N; "REAL" K1;
     NONEXP BESS KA01(A, X, KAN[0], K1); A:= A-1; X:= 2/X;
     "IF" NMAX > 0 "THEN" KAN[1]:= K1;
     "FOR" N:= 2 "STEP" 1 "UNTIL" NMAX "DO"
     KAN[N]:= KAN[N-2] + (A+N)*X*KAN[N-1];
   "END" NONEXP BESS KAPLUSN;
         "EOP"
1SECTION : 6.10.3             (DECEMBER 1978)                     PAGE 1
 
 
 
 AUTHOR: M. BAKKER.
 
 
 INSTITUTE: MATHEMATICAL CENTRE.
 
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THE PROCEDURES
 
     SPHER BESS J:
         THIS PROCEDURE CALCULATES THE SPHERICAL BESSEL FUNCTIONS
         J[K+.5](X)*SQRT(PI/(2*X)),K=0, ..., N, WHERE J[K+.5](X)
         DENOTES THE BESSEL FUNCTION OF THE FIRST KIND OF ORDER K+.5;
         X>= 0;
 
     SPHER BESS Y:
         THIS PROCEDURE CALCULATES THE SPHERICAL BESSEL FUNCTIONS
         Y[K+.5](X)*SQRT(PI/(2*X)), K=0, ..., N, WHERE Y[K+.5](X)
         DENOTES THE BESSEL FUNCTION OF THE THIRD KIND OF ORDER K+.5;
         X SHOULD BE POSITIVE;
 
     SPHER BESS I:
         THIS PROCEDURE CALCULATES THE MODIFIED SPHERICAL BESSEL
         FUNCTIONS I[K+.5](X)*SQRT(PI/(2*X))), K=0, ..., N,
         WHERE I[K+.5](X) DENOTES THE MODIFIED BESSEL FUNCTION OF THE
         FIRST KIND OF ORDER K+.5; X>=0;
 
     NONEXP SPHER BESS I:
         THIS   PROCEDURE   CALCULATES  THE  MODIFIED  SPHERICAL  BESSEL
         FUNCTIONS MULTIPIED BY EXP(-X)
               EXP(-X)*I[K+.5](X)*SQRT(PI/(2*X)), K=0, ...,N,
         WHERE I[K+.5](X) DENOTES THE MODIFIED BESSEL FUNCTION
         OF THE FIRST KIND OF ORDER K+.5; X>= 0;
 
     SPHER BESS K:
         THIS PROCEDURE CALCULATES THE MODIFIED SPHERICAL BESSEL
         FUNCTIONS
             K[I+.5](X)*SQRT(PI/(2*X)), I=0, ...,N,
         WHERE K[I+.5](X) DENOTES THE MODIFIED BESSEL FUNCTION
         OF THE THIRD KIND OF ORDER I+.5; X>0;
 
     NONEXP SPHER BESS K:
         THIS   PROCEDURE   CALCULATES  THE  MODIFIED  SPHERICAL  BESSEL
         FUNCTIONS  MULTIPLIED BY EXP(+X)
             EXP(+X)*K[I+.5](X)*SQRT(PI/(2*X)), I=0, ..., N,
         WHERE K[I+.5](X) DENOTES THE MODIFIED BESSEL
         FUNCTION OF THE THIRD KIND OF ORDER I+.5; X>0;
1SECTION : 6.10.3             (DECEMBER 1978)                     PAGE 2
 
 
 
 KEYWORDS:
 
     BESSEL FUNCTIONS,
     SPHERICAL BESSEL FUNCTIONS,
     MODIFIED SPHERICAL BESSEL FUNCTIONS.
 
 
 REFERENCES:

     [1]. ABRAMOWITZ, M., AND STEGUN, I. (EDS),
         HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND
         MATHEMATICAL TABLES.
         APPL. MATH. SER. 55, U.S. GOVT. PRINTING OFFICE,
         WASHINGTON, D.C. , 1974.
 
     [2]. GAUTSCHI, W., COMPUTATIONAL ASPECTS OF
         THREE TERM RECURRENCE RELATIONS.
         SIAM REVIEW, VOLUME 9(1967), NUMBER 1, P.24 FF.
 
 
 SUBSECTION: SPHER BESS J.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" SPHER BESS J (X, N, J); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" J;
     "CODE" 35150;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  < ARITHMETIC EXPRESSION >;
         THE VALUE OF THE ARGUMENT; X > = 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY J; N > = 0;
     J:  < ARRAY IDENTIFIER >;
         "ARRAY" J[0:N];
         EXIT:  J[K] HAS THE VALUE OF THE SPHERICAL BESSEL FUNCTION
                J[K+.5](X) * SQRT(PI/(2*X)), 0< = K < = N;
 
 
 PROCEDURES USED: START  =  CP 35185.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
1SECTION : 6.10.3            (DECEMBER 1978)                     PAGE 3
 
 
 
 METHOD AND PERFORMANCE:
 
     AT FIRST THE RATIO OF TWO CONSEQUENT ARRAY ELEMENTS
     IS COMPUTED BY MEANS OF A BACKWARD RECURRENCE
     FORMULA USING MILLER 'S METHOD (SEE[2, P.46-52])
     AND HENCE ALL THE ARRAY ELEMENTS ARE COMPUTED SINCE
     THE ZEROTH ELEMENT IS KNOWN TO BE SIN(X)/X.
     THE STARTING VALUE IS COMPUTED BY START.
 
 
 RUNNING TIME:
 
     ROUGHLY PROPERTIONAL TO THE MAXIMUM OF X AND N.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X  ; "ARRAY" J[0:2]; "INTEGER" N;
         X:= 1.5; N:= 2; SPHER BESS J(X, N, J);
         OUTPUT(61, "("/, "("X=")" D.D, B"("N=")"D,/,
         3(3B-.14D"-ZD)")", X, N, J[0], J[1], J[2])
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
     X=1.5  N=2
     .66499665773603"0  .3961729707122"0  .12734928368841"0
 
 
 SUBSECTION: SPHER BESS Y.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" SPHER BESS Y(X, N, Y); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" Y;
     "CODE" 35151;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:  < ARITHMETIC EXPRESSION >;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY Y; N > = 0;
     Y:  < ARRAY IDENTIFIER >;
         "ARRAY" Y[0:N];
         EXIT:  Y[K] HAS THE VALUE OF THE K-TH SPHERICAL
                BESSEL FUNCTION OF THE SECOND KIND;
1SECTION : 6.10.3            (DECEMBER 1978)                     PAGE 4
 
 
 
 PROCEDURES USED: NONE.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     Y[0] AND Y[1] ARE GIVEN IN [1, P.438, FORMULA 10.1.12]
     AND Y[2], ..., Y[N] ARE COMPUTED BY USING THE
     RECURRENCE FORMULA
 
         Y[K]:= ((2*K-1)/X) * Y[K-1] - Y[K-2], K > = 2.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM
 
     "BEGIN" "REAL" X; "INTEGER" N; "ARRAY" Y[0:2];
         X:= 1.5707 96326 79489; "COMMENT" X= PI/2; N:= 2;
         SPHER BESS Y(X, N, Y);
         OUTPUT(61, "("2(4B-.10D"-ZD), /,
                       3(4B-.10D"-ZD)")", X, N, Y)
     "END"
 
     PRINTS THE FOLLOWING RESULTS:
 
     .15707963271"1  .2000000000"1
     -.6223649549"-13  -.6366197724"0  -.1215854204"1
 
 
 SUBSECTION: SPHER BESS I.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" SPHER BESS I(X, N, I); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" I;
     "CODE" 35152;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  < ARITHMETIC EXPRESSION >;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > = 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES  OF THE ARRAY I; N > = 0;
     I:  < ARRAY IDENTIFIER >;
         "ARRAY" I[0:N];
         EXIT:  I[K] HAS THE VALUE OF THE MODIFIED SPHERICAL
                BESSEL FUNCTION AS DESCRIBED IN [1, CH.10.2].
1SECTION : 6.10.3            (DECEMBER 1978)                     PAGE 5
 
 
 
 METHOD AND PERFORMANCE:
     AT FIRST THE NONEXPONENTIAL MODIFIED SPHERICAL BESSEL FUNCTIONS
     ARE COMPUTED BY USING THE PROCEDURE NONEXP SPHER BESS I;
     AFTERWARDS THEY ARE MULTIPLIED BY EXP(X).
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 PROCEDURES USED: NONEXP SPHER BESS I    =  CP 35154.
 
 
 EXAMPLE OF USE:
 
     THE PROGRAM SHOWS THAT THE RESULTS OF SPHER BESS I AND
     NONEXP SPHER BESS I DIFFER ONLY BY A FACTOR EXP(X):
 
     "BEGIN" "REAL" X, EXPX; "INTEGER" N; "ARRAY" I1, I2[0:3];
         X:=1; EXPX:= EXP(X); N:= 3; SPHER BESS I(X, N,I1);
         NONEXPSPHER BESS I(X, N, I2);"FOR" N:=0, 1, 2, 3 "DO"
         OUTPUT(61, "("/ZD, 2(5B-.14D"-ZD)")", N, I1[N], I2[N]*EXPX)
     "END"
 
     RESULTS:
 
     0  .11752011936438" 1    .11752011936438" 1
     1  .36787944117144" 0    .36787944117144" 0
     2  .71562870129474"-1    .71562870129474"-1
     3  .10065090524070"-1    .10065090524070"-1
 
 
 SUBSECTION: NONEXP SPHER BESS I.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" NONEXP SPHER BESS I(X, N, I);
     "VALUE" X, N; "REAL" X; "INTEGER" N; "ARRAY" I;
     "CODE" 35154;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X >= 0;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY I; N >= 0;
     I:  <ARRAY IDENTIFIER>;
         "ARRAY" I[0:N];
         EXIT: I[K] HAS THE VALUE OF THE FUNCTION
               I[K+.5](X)*EXP(-X)*SQRT(PI/(2*X)), K=0, ..., N, N >=0.
1SECTION : 6.10.3            (DECEMBER 1978)                     PAGE 6
 
 
 
 PROCEDURES USED: SINH  = CP 35111,
                  START = CP 35185.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
     THE RATIO OF TWO SUBSEQUENT ELEMENTS IS COMPUTED USING A BACKWARD
     RECURRENCE FORMULA ACCORDING MILLER'S METHOD (SEE[2]); SINCE THE
     ZEROETH ELEMENT IS KNOWN TO BE (1-EXP(-2*X))/(2*X), THE OTHER
    ELEMENTS FOLLOW IMMEDIATELY.THE STARTING VALUE IS COMPUTED BY START.
 
 
 EXAMPLE OF USE: SEE SPHER BESS I.
 
 
 SUBSECTION: SPHER BESS K.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" SPHER BESS K(X, N, K); "VALUE" X, N;
     "REAL" X; "INTEGER" N; "ARRAY" K;
     "CODE" 35153;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  < ARITHMETIC EXPRESSION >;
         THE ARGUMENT VALUE; X > 0;
     N:  < ARITHMETIC EXPRESSION >;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N > = 0;
     K:  < ARRAY IDENTIFIER >;
         "ARRAY" K[0:N];
         EXIT: K[J] HAS THE VALUE OF THE J-TH MODIFIED
               SPHERICAL BESSEL FUNCTION OF THE THIRD KIND,
               0 < = J < = N.
 
 
 PROCEDURES USED: NON EXP SPHER BESS K    =  CP 35155.
 
 
 REQUIRED CENTRAL MEMORY: NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 METHOD AND PERFORMANCE:
 
     AT FIRST THE NONEXPONENTIAL MODIFIED SPHERICAL BESSEL FUNCTIONS
     OF THE THIRD KIND ARE COMPUTED BY THE PROCEDURE NONEXP SPHER BESS K
     ; AFTERWARDS THEY ARE MULTIPLIED BY EXP(-X).
1SECTION : 6.10.3            (DECEMBER 1978)                     PAGE 7
 
 
 
 EXAMPLE OF USE:
 
     THE FOLLOWING PROGRAM SHOWS THAT THE RESULTS OF THE PROCEDURES
     SPHER BESS K EN NONEXP SPHER BESS K DIFFER ONLY BY A FACTOR EXP(X);
 
     "BEGIN" "REAL" X, EXPX; "INTEGER" N; "ARRAY" K1, K2[0:3];
         X:= 2; EXPX:= EXP(-X); N:= 3; SPHER BESS K (X, N, K1);
         NONEXPSPHER BESS K (X, N, K2); "FOR" N:= 0, 1, 2, 3 "DO"
         OUTPUT(61, "("/D, 2(5B-.14D"-ZD)")", N, K1[N], K2[N]*EXPX)
     "END"
 
     RESULTS:
 
     0    .10629208289691"0    .10629208289691"0
     1    .15943812434536"0    .15943812434536"0
     2    .34544926941495"0    .34544926941494"0
     3    .10230612978828"1    .10230612978828"1
 
 
 SUBSECTION: NONEXP SPHER BESS K.
 
 
 CALLING SEQUENCE:
 
     THE HEADING OF THE PROCEDURE READS:
     "PROCEDURE" NON EXP SPHER BESS K(X, N, K);
     "VALUE" X, N; "REAL" X; "INTEGER" N; "ARRAY" K;
     "CODE" 35155;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     X:  <ARITHMETIC EXPRESSION>;
         THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0;
     N:  <ARITHMETIC EXPRESSION>;
         THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N >= 0;
     K:  <ARRAY IDENTIFIER>;
         "ARRAY" K[0:N];
         EXIT: K[J] HAS THE VALUE OF THE FUNCTION
               K[J+.5](X)*EXP(X)*SQRT(PI/(2*X)), J=0,...,N.
 
 PROCEDURES USED: NONE.
 
 REQUIRED CENTRAL MEMORY : NO AUXILIARY ARRAYS ARE DECLARED.
 
 METHOD AND PERFORMANCE:
     THE FUNCTIONS ARE COMPUTED BY USING THE (NUMERICALLY STABLE)
     RECURRENCE FORMULA : K[J]=((2*J-1)/X)*K[J-1]+K[J-2], J >=2,
                          K[0]=PI/(2*X), K[1]=K[0]*(1+1/X) .
 
 EXAMPLE OF USE: SEE SPHER BESS K.
1SECTION : 6.10.3            (DECEMBER 1978)                     PAGE 8
 
 
 
 SOURCE TEXT(S):
0"CODE" 35150;
   "COMMENT" SPHERICAL BESSEL FUNCTIONS J[.5](X),  , J[N+.5](X);
   "PROCEDURE" SPHER BESS J(X, N, J); "VALUE" X, N;
   "REAL" X; "INTEGER" N; "ARRAY" J;
   "IF" X = 0 "THEN"
   "BEGIN" J[0]:= 1;
     "FOR" N:= N "STEP" -1 "UNTIL" 1 "DO" J[N]:=0
   "END" "ELSE" "IF" N = 0 "THEN"
   "BEGIN" "REAL" X2;
     "IF" ABS(X) < .015 "THEN"
     "BEGIN" X2:= X * X / 6; J[0]:= 1 + X2 * (X2 * .3 - 1) "END" "ELSE"
     J[0]:= SIN(X)/X
   "END" "ELSE"
   "BEGIN" "INTEGER" M; "REAL" R, S;
     R:= 0; M:= START(X,N,0);
     "FOR" M:= M "STEP" - 1 "UNTIL" 1 "DO"
     "BEGIN" R:= 1 / ((M + M + 1) / X - R); "IF" M <= N "THEN" J[M]:= R
     "END"; "IF" X < .015  "THEN"
     "BEGIN" S:= X * X / 6;
       J[0]:= R:= S * (S * .3 - 1) + 1 "END" "ELSE"
     J[0]:= R:= SIN(X) / X;
     "FOR" M:= 1 "STEP" 1 "UNTIL" N "DO" J[M]:= R:= J[M] * R;
   "END" SPHER BESS J;
         "EOP"
 
 "CODE" 35151;
   "COMMENT" SPHERICAL BESSEL FUNCTIONS Y[.5](X),   , Y[N+.5](X);
   "PROCEDURE" SPHER BESS Y(X, N, Y); "VALUE" X, N;
   "INTEGER" N; "REAL" X; "ARRAY" Y;
   "IF" N=0 "THEN"  Y[0]:= - COS(X)/X "ELSE"
   "BEGIN" "REAL" YI, YI1, YI2; "INTEGER" I;
     YI2:= Y[0]:= -COS(X)/X; YI1:= Y[1]:= (YI2 - SIN(X))/X;
     "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO"
     "BEGIN" Y[I]:= YI:= -YI2 + (I+I-1) * YI1/X;
       YI2:= YI1; YI1:= YI
     "END"
   "END"
1SECTION : 6.10.3             (DECEMBER 1978)                     PAGE 9
 
 
                                                                   ;
         "EOP"
 "CODE" 35152;
   "COMMENT" SPHERICAL BESSEL FUNCTIONS I[.5](X),   , I[N+.5](X);
   "PROCEDURE" SPHER BESS I(X, N, I); "VALUE" X, N;
   "REAL" X; "INTEGER" N; "ARRAY" I;
   "IF" X= 0 "THEN"
   "BEGIN" I[0]:=1;
     "FOR" N:= N "STEP" -1 "UNTIL"  1 "DO" I[N]:= 0
   "END" "ELSE"
   "BEGIN" "REAL" EXPX;
     EXPX:= EXP(X);
     NONEXP SPHER BESS I(X, N, I);
     "FOR" N:= N "STEP" - 1 "UNTIL" 0 "DO" I [N]:= I [N] * EXPX
   "END" SPHER BESS I;
         "EOP"
 
 "CODE" 35153;
   "COMMENT" MODIFIED SPHERICAL BESSEL FUNCTIONS
       K[.5](X),   , K[N+.5](X);
   "PROCEDURE" SPHER BESS K(X, N, K); "VALUE" X, N;
   "INTEGER" N; "REAL" X; "ARRAY" K;
   "BEGIN" "REAL" EXPX;
     EXPX:= EXP(-X);
     NONEXP SPHER BESS K(X, N, K);
     "FOR" N:= N "STEP" -1 "UNTIL" 0 "DO" K[N]:= K[N] * EXPX
   "END"
1SECTION : 6.10.3             (DECEMBER 1978)                    PAGE 10
 
 
                                                                  ;
         "EOP"
 "CODE" 35154;
   "PROCEDURE" NONEXP SPHER BESS I(X, N, I); "VALUE" X, N;
   "REAL" X; "INTEGER" N; "ARRAY" I;
   "IF" X= 0 "THEN"
   "BEGIN" I[0]:=1;
     "FOR" N:= N "STEP" -1 "UNTIL" 1 "DO" I[N]:= 0
   "END" "ELSE"
   "BEGIN" "REAL" X2, R, S; "INTEGER" M;
     X2:= X+X;
     I[0]:= X2:= "IF" X = 0 "THEN" 1 "ELSE" "IF" X2 < 0.7 "THEN"
         SINH(X) / (X * EXP(X)) "ELSE" (1-EXP(-X2))/X2;
     "IF" N= 0 "THEN" "GO TO" EXIT;
     R:= 0; M:= START(X,N,1);
     "FOR" M:= M "STEP" -1 "UNTIL" 1 "DO"
     "BEGIN" R:= 1/((M+M+1)/X+R);
       "IF" M  <=  N "THEN" I[M]:= R
     "END";
     "FOR" M:= 1 "STEP" 1 "UNTIL" N "DO"
     I[M]:= X2:= X2 * I[M];       EXIT:
   "END";
         "EOP"
 
 "CODE" 35155;
   "PROCEDURE" NONEXP SPHER BESS K(X, N, K); "VALUE" X, N;
   "REAL" X; "INTEGER" N; "ARRAY" K;
   "BEGIN" "INTEGER" I; "REAL" KI, KI1, KI2;
     X:= 1/X; K[0]:= KI2:= X*1.5707963267949;
     "IF" N=0 "THEN" "GO TO" EXIT;
     K[1]:= KI1:= KI2 * (1+X);
     "FOR" I:= 2 "STEP" 1 "UNTIL" N "DO"
     "BEGIN" K[I]:= KI:= KI2 + (I+I-1) * X * KI1;
       KI2:= KI1; KI1:= KI "END";
     EXIT:
   "END";
         "EOP"
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 1
 
 
 
 AUTHOR : P.W.HEMKER.
 
 
 CONTRIBUTOR : F.GROEN.
 
 
 INSTITUTE : MATHEMATICAL CENTRE.
 
 
 RECEIVED : 740620.
 
 
 BRIEF DESCRIPTION :
 
     THIS SECTION CONTAINS TWO PROCEDURES FOR THE EVALUATION OF  AIRY
     FUNCTIONS AND COMPUTING THEIR ZEROS. FOR THE DEFINITION OF THESE
     FUNCTIONS SEE REF[1].
 
     AIRY EVALUATES THE AIRY FUNCTIONS AI(Z) AND BI(Z) AND
     THEIR DERIVATIVES.
 
     AIRYZEROS COMPUTES THE ZEROS AND ASSOCIATED VALUES
     OF THE AIRY FUNCTIONS AI(Z) AND BI(Z) AND THEIR DERIVATIVES.
 
 
 
 KEYWORDS :
 
     AIRY FUNCTION,
     DERIVATIVE AIRY FUNCTION,
     ZERO OF AIRY FUNCTION.
 
 
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 2
 
 
 
 SUBSECTION : AIRY.
 
 
 CALLING SEQUENCE :
 
     THE HEADING OF THE PROCEDURE READS :
 
     "PROCEDURE" AIRY(X,AI,AID,BI,BID,EXPON,FIRST);
     "VALUE" X,FIRST; "BOOLEAN" FIRST;
     "REAL" X,AI,AID,BI,BID,EXPON;
     "CODE" 35140;
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     X:          <ARITHMETIC EXPRESSION>;
                 ENTRY : THE REAL ARGUMENT OF THE AIRY FUNCTIONS.
     AI:         <VARIABLE>;
                 EXIT :  THE  VALUE  OF  THE AIRY
                         FUNCTION AI IS GIVEN BY : EXP( -EXPON ) * AI.
                         NOTE :  IF X < 9 THEN EXPON = 0.
     AID:         <VARIABLE>;
                 EXIT :  THE  VALUE  OF  THE  DERIVATIVE OF  THE AIRY
                         FUNCTION AI IS GIVEN BY : EXP( -EXPON ) * AID.
                         NOTE :  IF X < 9 THEN EXPON = 0.
     BI:         <VARIABLE>;
                 EXIT :  THE  VALUE  OF  THE AIRY
                         FUNCTION BI IS GIVEN BY : EXP( EXPON ) * BI.
                         NOTE :  IF X < 9 THEN EXPON = 0.
     BID:         <VARIABLE>;
                 EXIT :  THE  VALUE  OF  THE  DERIVATIVE OF  THE AIRY
                         FUNCTION BI IS GIVEN BY : EXP( EXPON ) * BID.
                         NOTE :  IF X < 9 THEN EXPON = 0.
     EXPON:      <VARIABLE>;
                 EXIT : IF X < 9 THEN 0 ELSE 2/3 * X ** (3/2).
     FIRST:      <BOOLEAN EXPRESSION>;
                 FIRST SHOULD BE "FALSE" UNLESS THE PROCEDURE IS CALLED
                 FOR  THE  FIRST  TIME. IF FIRST IS "TRUE" THEN TWO OWN
                 ARRAYS OF COEFFICIENTS ARE BUILT UP.
 
 
 PROCEDURES USED : NONE.
 
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 3
 
 
 
 REQUIRED CENTRAL MEMORY : TWO OWN ARRAYS OF ORDER 10 ARE DECLARED.
 
 
 RUNNING TIME : IF 2.5 <= X <= 8 THEN ABOUT 8"-3 SEC., ELSE BETWEEN
     3"-3 AND 4"-3 SEC. ON THE CYBER 73/28.
 
 
 LANGUAGE : ALGOL 60.
 
 
 METHOD AND PERFORMANCE :
 
     SEE REF[2] OF THE SUBSECTION AIRYZEROS (THIS SECTION).
 
 
 REFERENCES :
 
     SEE REFERENCES OF THE SUBSECTION AIRYZEROS (THIS SECTION).
 
 
 
 EXAMPLE OF USE :
 
     "BEGIN" "REAL" A,B,C,D,E;
         AIRY(9.654894,A,B,C,D,E,"TRUE");
         OUTPUT(61,"("/,"("AI (9.654894) = ")",N")",A*EXP(-E));
         OUTPUT(61,"("/,"("AID(9.654894) = ")",N")",B*EXP(-E));
         OUTPUT(61,"("/,"("BI (9.654894) = ")",N")",C*EXP( E));
         OUTPUT(61,"("/,"("BID(9.654894) = ")",N")",D*EXP( E));
     "END"
 
     RESULTS :
 
     AI (9.654894) = +3.2873525549165"-010
     AID(9.654894) = -1.0297999323482"-009
     BI (9.654894) = +1.5583887049670"+008
     BID(9.654894) = +4.8010374682654"+008
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 4
 
 
 
 SUBSECTION : AIRYZEROS.
 
 
 CALLING SEQUENCE :
 
 
     THE HEADING OF THE PROCEDURE READS :
 
     "REAL" "PROCEDURE" AIRYZEROS(N,D,ZAI,VAI);
     "VALUE" N,D; "INTEGER" N,D; "ARRAY" ZAI,VAI;
     "CODE" 35145;
 
     AIRYZEROS := THE N-TH ZERO OF THE SELECTED AIRY-FUNCTION.
 
     THE MEANING OF THE FORMAL PARAMETERS IS :
     N :         <ARITHMETIC EXPRESSION>;
                 ENTRY : THE NUMBER OF ZEROS TO BE CALCULATED;
     D :         <ARITHMETIC EXPRESSION>;
                 ENTRY : AN  INTEGER  WHICH  SELECTS THE  REQUIRED AIRY
                         FUNCTION. D = 0, 1, 2 OR 3.
     ZAI :       <ARRAY IDENTIFIER>;
                 "ARRAY" ZAI[1 : N];
                 EXIT : ZAI[J] CONTAINS THE J-TH ZERO OF THE SELECTED
                        AIRY-FUNCTION :
                            IF D = 0 THEN AI(Z),
                            IF D = 1 THEN (D/DX) AI(X),
                            IF D = 2 THEN BI(X),
                            IF D = 3 THEN (D/DX) BI(X);
     VAI :       <ARRAY IDENTIFIER>;
                 "ARRAY" VAI[1 : N];
                 EXIT: VAI[J] CONTAINS THE VALUE AT X = ZAI[J] OF THE
                       FOLLOWING FUNCTION :
                           IF D = 0 THEN (D/DX) AI(X),
                           IF D = 1 THEN AI(X),
                           IF D = 2 THEN (D/DX) BI(X),
                           IF D = 3 THEN BI(X);
 
 
 PROCEDURES USED :
 
     AIRY  = CP35140;
 
 
 REQUIRED CENTRAL MEMORY : NO AUXILIARY ARRAYS ARE DECLARED.
 
 
 RUNNING TIME : DEPENDENT ON THE VALUES OF N AND D. IN MOST CASES THE
     RUNNING TIME IS LESS  THAN  N * 0.01 SEC. ON THE CYBER 73/28.
 
 
 LANGUAGE : ALGOL 60.
 
 
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 5
 
 
 
 METHOD AND PERFORMANCE :
 
     A FIRST APPROXIMATION OF THE ZEROS OF THE SELECTED AIRY-FUNCTION IS
     CALCULATED BY MEANS OF THE ASYMPTOTIC EXPANSION ( SEE THE FORMULAS
     10.4.94 - 10.4.105 OF REF[1] ); THIS VALUE IS CORRECTED BY THE
     (REPEATED) USE OF A QUADRATIC INTERPOLATION RULE.
     THE  COMPUTED  ZEROS  WILL  SATISFY AT  LEAST ONE OF THE  FOLLOWING
     CONDITIONS :
     1: THE  ABSOLUTE  VALUE OF THE SELECTED AIRY-FUNCTION AT A COMPUTED
        ZERO IS LESS THAN "-12. NOTE: THE VALUES OF THE AIRY-FUNCTIONS
        ARE CALCULATED BY MEANS OF THE PROCEDURE AIRY (THIS SECTION).
     2: THE RELATIVE PRECISION OF THE COMPUTED  ZERO IS "-14.
     THE ASSOCIATED VALUES ( DELIVERED IN THE ARRAY VAI ) ARE ALSO
     CALCULATED BY MEANS OF THE PROCEDURE AIRY (THIS SECTION).
 
 
 
 REFERENCES :
 
 
     [1] : M.ABRAMOWITZ AND I.A.STEGUN,
           HANDBOOK OF MATHMATICAL FUNCTIONS,
           DOVER PUBLICATIONS, INC. NEW YORK, 1965.
 
 
     [2] : R.G.GORDON,
           EVALUATION OF AIRY FUNCTIONS,
           THE JOURNAL OF CHEMICAL PHYSICS, VOLUME 51, 1969, PP. 23-24.
 
 
 EXAMPLE OF USE :
 
     "BEGIN" "ARRAY" ZBI,VBID[1 : 3];
     OUTPUT(61,"("/"("THE THIRD ZERO OF BI(X) IS")"/,N,
                  /"("THE VALUE OF (D/DX)BI(X) IN THIS POINT IS")"/,N")"
                  ,AIRYZEROS(3,2,ZBI,VBID),VBID[3])
     "END"
 
     RESULTS :
 
     THE THIRD ZERO OF BI(X) IS
     -4.8307378416626"+000
     THE VALUE OF (D/DX)BI(X) IN THIS POINT IS
     +8.3699101261986"-001
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 6
 
 
 
 SOURCE TEXT(S):
 
0"CODE" 35140;
  "PROCEDURE" AIRY(Z,AI,AID,BI,BID,EXPON,FIRST);
  "VALUE" Z,FIRST; "BOOLEAN" FIRST;
  "REAL" Z,AI,AID,BI,BID,EXPON;
  "BEGIN" "REAL" S,T,U,V,SC,TC,UC,VC,X,K1,K2,K3,K4,
      C,ZT,SI,CO,EXPZT,SQRTZ,WWL,PL,PL1,PL2,PL3;
      "OWN" "REAL" C1,C2,SQRT3,SQRT1OPI,PIO4;
      "OWN" "REAL" "ARRAY" XX,WW[1:10];
      "INTEGER" N,L;
 
      "IF" FIRST "THEN"
      "BEGIN" SQRT3:=    1.73205080756887729;
              SQRT1OPI:= 0.56418958354775629;
              PIO4:=     0.78539816339744831;
              C1:=       0.35502 80538 87817;
              C2:=       0.25881 94037 92807;
              XX[ 1]:=   1.40830 81072 180964 "+1;
              XX[ 2]:=   1.02148 85479 197331 "+1;
              XX[ 3]:=   7.44160 18450 450930    ;
              XX[ 4]:=   5.30709 43061 781927    ;
              XX[ 5]:=   3.63401 35029 132462    ;
              XX[ 6]:=   2.33106 52303 052450    ;
              XX[ 7]:=   1.34479 70824 609268    ;
              XX[ 8]:=   6.41888 58369 567296 "-1;
              XX[ 9]:=   2.01003 45998 121046 "-1;
              XX[10]:=   8.05943 59172 052833 "-3;
              WW[ 1]:=   3.15425 15762 964787"-14;
              WW[ 2]:=   6.63942 10819 584921"-11;
              WW[ 3]:=   1.75838 89061 345669"- 8;
              WW[ 4]:=   1.37123 92370 435815"- 6;
              WW[ 5]:=   4.43509 66639 284350"- 5;
              WW[ 6]:=   7.15550 10917 718255"- 4;
              WW[ 7]:=   6.48895 66103 335381"- 3;
              WW[ 8]:=   3.64404 15875 773282"- 2;
              WW[ 9]:=   1.43997 92418 590999"- 1;
              WW[10]:=   8.12311 41336 261486"- 1;
      "END";
 
      EXPON:= 0;
      "IF" Z >= -5.0 "AND" Z <= 8 "THEN"
      "BEGIN" U:= V:= T:= UC:= VC:= TC:= 1;
          S:= SC:= 0.5; N:= 0; X:= Z*Z*Z;
          "FOR" N:= N+3 "WHILE" ABS(U)+ABS(V)+ABS(S)+ABS(T)
                                 > "-18 "DO"
          "BEGIN" U:=U*X/(N*(N-1)); V:= V*X/(N*(N+1));
                  S:=S*X/(N*(N+2)); T:= T*X/(N*(N-2));
                  UC:= UC+U; VC:= VC+V; SC:= SC+S; TC:= TC+T
          "END";
                                                               "COMMENT"
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 7
                                                                  ;
 
 
          BI:= SQRT3 * (C1*UC + C2*Z*VC);
          BID:=SQRT3 * (C1*Z*Z*SC +C2*TC);
          "IF" Z<2.5 "THEN"
          "BEGIN" AI:= C1*UC - C2*Z*VC;
                  AID:= C1*SC*Z*Z - C2*TC;
                  "GOTO" END
          "END"
      "END";
 
      K1:= K2:= K3:= K4:= 0;
      SQRTZ:= SQRT(ABS(Z));
      ZT:= 0.66666 66666 66667 * ABS(Z)*SQRTZ;
      C:= SQRT1OPI/SQRT(SQRTZ);
      "IF" Z<0 "THEN"
      "BEGIN" Z:= -Z; CO:= COS(ZT-PIO4); SI:= SIN(ZT-PIO4);
          "FOR" L:= 1 "STEP" 1 "UNTIL" 10 "DO"
          "BEGIN" WWL:= WW[L]; PL:= XX[L]/ZT;
              PL2:=PL*PL; PL1:= 1+PL2; PL3:= PL1*PL1;
              K1:= K1 + WWL/PL1;
              K2:= K2 + WWL*PL/PL1;
              K3:= K3 + WWL*PL*(1+PL*(2/ZT+PL))/PL3;
              K4:= K4 + WWL*(-1-PL*(1+PL*(ZT-PL))/ZT)/PL3;
          "END";
          AI:= C*(CO*K1+SI*K2);
          AID:= 0.25*AI/Z - C*SQRTZ*(CO*K3+SI*K4);
          BI:= C*(CO*K2-SI*K1);
          BID:= 0.25*BI/Z - C*SQRTZ*(CO*K4-SI*K3);
      "END" "ELSE"
      "BEGIN" "IF" Z < 9 "THEN" EXPZT:= EXP(ZT) "ELSE"
          "BEGIN" EXPZT:= 1; EXPON:= ZT "END";
          "FOR" L:= 1 "STEP" 1 "UNTIL" 10 "DO"
          "BEGIN" WWL:= WW[L]; PL:= XX[L]/ZT;
              PL1:= 1+PL; PL2:= 1-PL;
              K1:= K1 + WWL/PL1;
              K2:= K2 + WWL*PL/(ZT*PL1*PL1);
              K3:= K3 + WWL/PL2;
              K4:= K4 + WWL*PL/(ZT*PL2*PL2);
          "END";
          AI:= 0.5*C*K1/EXPZT;
          AID:= AI*(-.25/Z-SQRTZ) + 0.5*C*SQRTZ*K2/EXPZT;
          "IF" Z >= 8 "THEN"
          "BEGIN" BI:= C*K3*EXPZT;
                  BID:= BI*(SQRTZ-0.25/Z) - C*K4*SQRTZ*EXPZT;
          "END";
      "END";
   END:
  "END" AIRY
1SECTION : 6.10.4            (OCTOBER 1975)                      PAGE 8
 
 
                                                                   ;
         "EOP"
0"CODE" 35145;
 "REAL" "PROCEDURE" AIRYZEROS(N,D,ZAI,VAI);
 "VALUE" N,D; "INTEGER" N,D; "ARRAY" ZAI,VAI;
 "BEGIN" "BOOLEAN" A, FOUND; "INTEGER" I;
     "REAL" C,E,R,ZAJ,ZAK,VAJ,DAJ,KAJ,ZZ;
 
     A :=  D = 0 "OR" D = 2;
     R := "IF" D = 0 "OR" D = 3 "THEN" -1.1780 97245 09617
                                "ELSE" -3.5342 91735 28852;
     "COMMENT"  R := "IF" D = 0 "OR" D = 3 "THEN" -3 * PI / 8
                                           "ELSE" -9 * PI / 8;
     AIRY(0,ZAJ,VAJ,DAJ,KAJ,ZZ,"TRUE");
     "FOR" I := 1 "STEP" 1 "UNTIL" N "DO"
     "BEGIN" R := R + 4.7123 88980 38469; "COMMENT" R := R + 3 * PI / 2;
         ZZ := R * R;
         ZAJ := "IF" I = 1 "AND" D = 1 "THEN" -1.01879 297 "ELSE"
                "IF" I = 1 "AND" D = 2 "THEN" -1.17371 322 "ELSE"
                R ** 0.66666 66666 66667 * ( "IF" A "THEN"
                - ( 1 + ( 5/48 - ( 5/36 - ( 77125/82944 - (
                1080 56875 / 69 67296 - (16 23755 96875 / 3344 30208)
                /ZZ)/ZZ)/ZZ)/ZZ)/ZZ)
                                                    "ELSE"
                - ( 1 - ( 7/48 - ( 35/288 - ( 1 81223 / 2 07360 - (
                186 83371 / 12 44160 - ( 9 11458 84361 / 1911 02976 )
                /ZZ)/ZZ)/ZZ)/ZZ)/ZZ));
         "IF"  D <= 1 "THEN" AIRY(ZAJ,VAJ,DAJ,C,E,ZZ,"FALSE")
                      "ELSE" AIRY(ZAJ,C,E,VAJ,DAJ,ZZ,"FALSE");
         FOUND := ABS( "IF" A "THEN" VAJ "ELSE" DAJ ) < "-12;
         "FOR" C := C "WHILE" "NOT" FOUND "DO"
         "BEGIN" "IF" A "THEN"
             "BEGIN" KAJ := VAJ / DAJ;
                 ZAK := ZAJ - KAJ * (1 + ZAJ * KAJ * KAJ)
             "END" "ELSE"
             "BEGIN" KAJ := DAJ / (ZAJ * VAJ);
                 ZAK := ZAJ - KAJ * (1 + KAJ * (KAJ * ZAJ + 1 / ZAJ))
             "END";
             "IF"  D <= 1 "THEN" AIRY(ZAK,VAJ,DAJ,C,E,ZZ,"FALSE")
                          "ELSE" AIRY(ZAK,C,E,VAJ,DAJ,ZZ,"FALSE");
             FOUND := ABS(ZAK - ZAJ) < "-14 * ABS(ZAK) "OR"
                      ABS("IF" A "THEN" VAJ "ELSE" DAJ) < "-12;
             ZAJ := ZAK
         "END";
         VAI[I] := "IF" A "THEN" DAJ "ELSE" VAJ;
         ZAI[I] := ZAJ;
     "END";
     AIRYZEROS := ZAI[N];
 "END" AIRYZEROS;
         "EOP"
1SECTION : 7.1.1.1.1          (NOVEMBER 1978)                     PAGE 1
 
 
 
 AUTHOR:         C.G. VAN DER LAAN
 
 CONTRIBUTORS:   C.G. VAN DER LAAN, M. VOORINTHOLT
 
 INSTITUTE:      REKENCENTRUM RIJKSUNIVERSITEIT GRONINGEN
 
 RECEIVED:       780601
 
 BRIEF DESCRIPTION:
 
     NEWTON CALCULATES THE COEFFICIENTS OF THE NEWTON POLYNOMIAL
     THROUGH GIVEN INTERPOLATION POINTS AND CORRESPONDING
     FUNCTION VALUES.
 
 
 KEYWORDS:
 
     NEWTON INTERPOLATION,
     POLYNOMIAL COEFFICIENTS,
     DIVIDED DIFFERENCES.
 
 
 CALLING SEQUENCE:
 
     THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS:
     "PROCEDURE" NEWTON(N,X,F);
     "VALUE"N;"INTEGER"N;"ARRAY"X,F;
     "CODE" 36010;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     N:  <ARITHMETIC EXPRESSION>;
         THE DEGREE OF THE POLYNOMIAL;
     X:  <ARRAY IDENTIFIER>;
         "ARRAY"X[0:N];
         ENTRY:  THE INTERPOLATION POINTS;
     F:  <ARRAY IDENTIFIER>;
         "ARRAY"F[0:N];
         ENTRY:  THE FUNCTION VALUES AT THE INTERPOLATION POINTS;
         EXIT:   THE COEFFICIENTS OF THE NEWTON POLYNOMIAL.
 
 
 PROCEDURES USED: NONE.
 
 
 RUNNING TIME: THE NUMBER OF DIVISIONS IS N(N+1)/2.
1SECTION : 7.1.1.1.1          (NOVEMBER 1978)                     PAGE 2
 
 
 
 METHOD AND PERFORMANCE:
 
     THE POLYNOMIAL OF DEGREE N IN X IS REPRESENTED AS
               N           K-1
              SUM (A[K] * PROD (X-X[L])).
              K=0          L=0
     THE COEFFICIENTS OF THE (NEWTON) POLYNOMIAL, A[0:N], ARE
     CALCULATED BY INTERPOLATION AT THE GIVEN ARGUMENTS, X[0:N],
     AND FUNCTION VALUES, F[0:N]; THE RESULTING SET OF EQUATIONS IS
     SOLVED BY TRANSFORMING THE CORRESPONDING LOWER TRIANGULAR MATRIX
     TO DIAGONAL FORM.
 
 
 EXAMPLE OF USE:
 
     "BEGIN" "ARRAY" X,F[0:2];
         X[0]:=0;X[1]:=.5;X[2]:=1;
         F[0]:=1;F[1]:=F[2]:=0;
         NEWTON(2,X,F);
         OUTPUT(61,"("/,"("THE NEWTON COEFF. ARE")",
             /,3(N)")",F[0],F[1],F[2]);
     "END"TSTNEWTON
 
     THE NEWTON COEFF. ARE
     +1.0000000000000"+000  -2.0000000000000"+000  +2.0000000000000"+000
1SECTION : 7.1.1.1.1          (NOVEMBER 1978)                     PAGE 3
 
 
 
 SOURCE TEXT(S):
 
 "CODE"36010;
 "PROCEDURE" NEWTON(N,X,F);
 "VALUE" N; "INTEGER" N; "ARRAY" X,F;
 "COMMENT" NEWTON DETERMINES THE COEFFICIENTS C[J],J=0,...N,
 OF THE INTERPOLATION POLYNOMIAL C[0] + C[1] *(X-X[0])+...+
 C[N] * (X-X[0])*...*(X-X[N-1]) OUT OF N+1 LIN. EQUAT.
 THE ARGUMENTS AND FUNCTION VALUES MUST BE GIVEN IN
 ARRAY X, F[0:N]. THE ARRAY F IS OVERWRITTEN BY
 THE COEFFICIENTS C[J],J=0,...N;
 "BEGIN" "INTEGER" K,I,IM1;
 "REAL" XIM1,FIM1;
 IM1:=0;
 "FOR" I:= 1 "STEP" 1 "UNTIL" N "DO"
 "BEGIN" FIM1:=F[IM1];XIM1:=X[IM1];
     "FOR" K:= I "STEP" 1 "UNTIL" N "DO" F[K]:= (F[K]-FIM1)/(X[K]-XIM1);
     IM1:= I
 "END"
 "END" NEWTON;
         "EOP"
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 1
 
 
 
 AUTHOR:         C.G. VAN DER LAAN
 
 CONTRIBUTORS:   C.G. VAN DER LAAN, M. VOORINTHOLT
 
 INSTITUTE:      REKENCENTRUM RIJKSUNIVERSITEIT GRONINGEN
 
 RECEIVED:       780601
 
 BRIEF DESCRIPTION:
 
     THIS SECTION CONTAINS THREE PROCEDURES:
 
     MINMAXPOL:  CALCULATES THE COEFFICIENTS OF THE POLYNOMIAL
                 (AS A SUM OF POWERS) WHICH APPROXIMATES A FUNCTION,
                 GIVEN FOR DISCRETE ARGUMENTS, IN SUCH A WAY THAT THE
                 INFINITY NORM OF THE ERROR VECTOR IS MINIMIZED.
     INI:        SELECTS A (SUB)SET OF INTEGERS OUT OF A GIVEN
                 SET OF INTEGERS;
     SNDREMEZ:   EXCHANGES AT MOST N+1 NUMBERS WITH NUMBERS OUT OF
                 A REFERENCE SET;
     (INI AND SNDREMEZ ARE AUXILIARY PROCEDURES USED IN MINMAXPOL.)
 
 
 KEYWORDS:
 
     (SECOND) REMEZ ALGORITHM,
     MINIMAX POLYNOMIAL APPROXIMATION.
 
 
 REFERENCES:
 
     MEINARDUS, G. (1964):
     APPROXIMATION OF FUNCTION AND THEIR NUMERICAL TREATMENT (GERMAN).
     SPRINGER TRACTS IN NATURAL PHILOSOPHY, VOL. 4.
 
     DEKKER, T.J. (1967):
     CURSUS WETENSCHAPPELIJK REKENEN A.
     MATHEMATISCH CENTRUM.
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 2
 
 
 SUBSECTION : MINMAXPOL.
 
 CALLING SEQUENCE:
 
     THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS:
     "PROCEDURE"MINMAXPOL(N,M,Y,FY,CO,EM);
     "VALUE"N,M;"INTEGER"N,M;"ARRAY"Y,FY,CO,EM;
     "CODE" 36022;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     N:      <ARITHMETIC EXPRESSION>;
             THE DEGREE OF THE APPROXIMATING POLYNOMIAL (N>=0);
     M:      <ARITHMETIC EXPRESSION>;
             THE NUMBER OF REFERENCE FUNCTION VALUES VIZ. ARGUMENTS
             IS M+1;
     Y,FY:   <ARRAY IDENTIFIERS>;
             "ARRAY"Y,FY[0:M];
             ENTRY: FY[I] IS THE FUNCTION VALUE AT Y[I], FOR I=0,...M;
     CO:     <ARRAY IDENTIFIER>;
             "ARRAY"CO[0:N];
             EXIT: THE COEFFICIENTS OF THE APPROXIMATING POLYNOMIAL
                   (CO[N] IS COEFFICIENT OF Y**N);
     EM:     <ARRAY IDENTIFIER>;
             "ARRAY"EM[0:3];
             ENTRY:  EM[2]:THE MAXIMUM ALLOWED NUMBER OF
                           ITERATIONS (SAY 10*N+5);
             EXIT:   EM[0]:THE DIFFERENCE OF THE GIVEN FUNCTION AND
                           THE POLYNOMIAL IN THE FIRST APPROXIMATION
                           POINT;
                     EM[1]:THE INFINITY NORM OF THE ERROR OF
                           APPROXIMATION OVER THE DISCRETE INTERVAL;
                     EM[3]:THE NUMBER OF ITERATIONS PERFORMED.
 
 PROCEDURES USED:  ELMVEC    = CP34020,
                   DUPVEC    = CP31030,
                   NEWTON    = CP36010,
                   POL       = CP31040,
                   NEWGRN    = CP31050,
                   INI       = CP36020,
                   SNDREMEZ  = CP36021.
 
 
 REQUIRED CENTRAL MEMORY:
 
     AN INTEGER ARRAY AND THREE (REAL) ARRAYS OF N+2 ELEMENTS AS
     WELL AS A (REAL) ARRAY OF M+1 ELEMENTS ARE INTERNALLY DECLARED.
 
 RUNNING TIME:
 
     THE SECOND REMEZ ALGORITHM (ON A DISCRETE SET) IS QUADRATIC
     CONVERGENT;IN EACH ITERATION THE NUMBER OF OPERATIONS
     (MULTIPLICATIONS AND ADDITIONS) IS PROPORTIONAL TO M*N.
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 3
 
 
 
 METHOD AND PERFORMANCE:  SEE MEINARDUS (1969),CH.7.
 
 EXAMPLE OF USE:
 
     "BEGIN""INTEGER"N;
 
      "PROCEDURE" COMPUTE(N,A,B,F);
      "VALUE" N,A,B;"INTEGER" N;"REAL" A,B;
      "REAL" "PROCEDURE" F;
      "BEGIN" "INTEGER" K,L,M;
          "REAL"R,T,IDM;
          "ARRAY" COEF[0:N],EM[0:3];
          EM[2]:=10*N+5;
          M:=100*N+10;
          "BEGIN" "ARRAY" Y,FY[0:M];
              IDM:=(B-A)/M;
              R:=Y[0]:=A;FY[0]:=F(R);
              R:=Y[M]:=B;FY[M]:=F(R);
              L:=M-1;
              "FOR"K:=1"STEP"1"UNTIL"L"DO"
              "BEGIN"R:=Y[K]:=A+K*IDM;FY[K]:=F(R) "END";
              MINMAXPOL(N,M,Y,FY,COEF,EM);
              OUTPUT(61,"(""("COEF:")"/")");
              "FOR"K:=0"STEP"1"UNTIL"N"DO"OUTPUT(61,"(" ")",COEF[K]);
              OUTPUT(61,"("/8S/,2(N),2(B+3ZDB),/")","("EM[0:3]")",EM[0],
              EM[1],EM[2],EM[3]);
          "END";
      "END" COMPUTE;
 
     "REAL""PROCEDURE"F(X);"VALUE"X;"REAL"X;
     F:=1/(X-10);
 
      "FOR" N:=1"DO"
         "BEGIN" OUTPUT(61,"("//,"("DEGREE=")",D//")",N);
             COMPUTE(N,-1,1,F)
         "END"
   "END"
 
 
     DEGREE=1
 
     COEF:
     -1.0050378153393"-001  -1.0101010101010"-002
     EM[0:3]
     -5.0631947616870"-004  +5.0631947616870"-004     +15     +3
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 4
 
 
 SUBSECTION : INI.
 
 CALLING SEQUENCE:
 
     THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS:
     "PROCEDURE" INI(N,M,S);
     "VALUE"N,M;"INTEGER"N,M;"INTEGER""ARRAY"S;
     "CODE" 36020;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     N,M:   <ARITHMETIC EXPRESSION>;
             THE NUMBER OF POINTS TO BE SELECTED EQUALS N+1;
             THE REFERENCE SET CONTAINS THE NUMBERS 0,1,...,M (M>=N);
     S:      <ARRAY IDENTIFIER>;
             "INTEGER" "ARRAY" S[0:N];
             EXIT: THE SELECTED INTEGERS ARE DELIVERED IN S.
 
 PROCEDURES USED: NONE.
 
 METHODS AND PERFORMANCE:
 
     THE ARGUMENTS FOR WHICH THE CHEBYSHEV POLYNOMIAL OF DEGREE N
     ATTAINS ITS EXTREME VALUES ON THE INTERVAL [-1,1] ARE TRANSFORMED
     TO THE INTERVAL [0,M] BY A LINEAR TRANSFORMATION; FINALLY THE
     NUMBERS ARE PROPERLY ROUNDED.
 
 EXAMPLE OF USE:
 
     "BEGIN""INTEGER""ARRAY"S[0:2];
     INI(2,20,S);
     OUTPUT(61,"(""("INI SELECTS OUT OF 0,1,...,20 THE NUMBERS:")",/,
        3(B-ZDB)")",S[0],S[1],S[2])
     "END"
 
     INI SELECTS OUT OF 0,1,...,20 THE NUMBERS:
        0   10   20
 
 
 SUBSECTION : SNDREMEZ.
 
 CALLING SEQUENCE:
 
     THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS:
     "PROCEDURE"SNDREMEZ(N,M,S,G,EM);
     "VALUE"N,M;"INTEGER"N,M;"INTEGER""ARRAY"S;"ARRAY" G,EM;
     "CODE" 36021;
 
     THE MEANING OF THE FORMAL PARAMETERS IS:
     N,M:    <ARITHMETIC EXPRESSION>;
             THE NUMBER OF POINTS TO BE EXCHANGED IS SMALLER THAN
             OR EQUAL TO N+1; THE REFERENCE SET CONTAINS THE
             NUMBERS 0,1,...,M (M>=N);
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 5
 
 
     S:      <ARRAY IDENTIFIER>;
             "INTEGER" "ARRAY" S[0:N];
             ENTRY: IN S ONE MUST GIVE N+1 (STRICTLY)
                    MONOTONE INCREASING NUMBERS OUT OF 0,...,M;
             EXIT : N+1 (STRICTLY) MONOTONE INCREASING NUMBERS OUT OF
                    THE NUMBERS 0,1,...,M;
     G:      <ARRAY IDENTIFIER>;
             "ARRAY" G[0:M];
             ENTRY: IN ARRAY G[0:M] ONE MUST GIVE FUNCTION VALUES;
     EM:     <ARRAY IDENTIFIER>;
             "ARRAY" EM[0:1];
             ENTRY: 0<EM[0]<=G[I],I=0,...,M;
             EXIT : EM[1]:=INFINITY NORM OF ARRAY G[0:M].
 
 
 PROCEDURES USED:  INFNRMVEC = CP31061.
 
 
 METHOD AND PERFORMANCE:
 
     THE SECOND REMEZ ALGORITHM IS USED (MEINARDUS,G.(1964)).
 
 
 EXAMPLE OF USE:
 
     "BEGIN""ARRAY"EM[0:1],G[0:7];"INTEGER""ARRAY"S[0:2];
     G[0]:=10;G[1]:=12;G[2]:=-15;G[3]:=-10;
     G[4]:=-14;G[5]:=15;G[6]:=10;G[7]:=11;
     EM[0]:=10;S[0]:=0;S[1]:=3;S[2]:=6;
     OUTPUT(61,"(""("THE NUMBERS:")",/,"("S[J]:")",3(B-D),/,
        "("G[S[J]]:")",3(B-DD)")",
        S[0],S[1],S[2],G[S[0]],G[S[1]],G[S[2]]);
     SNDREMEZ(2,7,S,G,EM);
     OUTPUT(61,"("//,"("ARE EXCHANGED WITH:")",/,"("S[J]:")",3(B-D),/,
        "("G[S[J]]:")",3(B-DD),//,
        "("THE REFERENCE SET OF FUNCTIONVALUES IS:")",/,8(B-DD)")",
        S[0],S[1],S[2],G[S[0]],G[S[1]],G[S[2]] ,
        G[0],G[1],G[2],G[3],G[4],G[5],G[6],G[7])
     "END"
 
 
     THE NUMBERS:
     S[J]:  0  3  6
     G[S[J]]:  10 -10  10
 
     ARE EXCHANGED WITH:
     S[J]:  0  2  5
     G[S[J]]:  10 -15  15
 
     THE REFERENCE SET OF FUNCTIONVALUES IS:
       10  12 -15 -10 -14  15  10  11
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 6
 
 
 SOURCE TEXT(S) :
0"CODE"36022;
  "PROCEDURE" MINMAXPOL(N,M,Y,FY,CO,EM);
  "VALUE" N,M;"INTEGER" N,M;
  "ARRAY" Y,FY,CO,EM;
  "COMMENT" MINMAXPOL CALCULATES THE COEFFICIENTS,
  CO[I],I=,.....N OF THE POLYNOMIAL
  P(Y)=CO[0]+CO[1]*Y+...+CO[N]*Y**N,
  THAT APPROXIMATES THE DISCRETE FUNCTION FY[I],I=0,...M,
  GIVEN FOR THE ARGUMENTS Y[I],I=0,...M,
  IN THE MINIMAX NORM.
  THE ARGUMENTS MUST BE GIVEN IN MONOTONE INCREASING ORDER.
  IN ARRAY EM[0:3], ONE MUST GIVE THE MAXIMUM ALLOWED NUMBER OF
  ITERATIONS,EM[2].
  MOREOVER,
  EM[0]:=THE DIFFERENCE OF THE GIVEN FUNCTION AND THE POLYNOMIAL
  IN THE FIRST APPROXIMATION POINT,
  EM[1]:=THE MAXIMUM OF ! P(Y[I])-FY[I]!  FOR I=0,...M,
  EM[3]:=THE NUMBER OF ITERATIONS PERFORMED.
  THE PROCEDURES ELMVEC,DUPVEC,POL,NEWTON,NEWGRN,
  INI,SNDREMEZ
  ARE USED.
  REFERENCE:MEINARDUS,G.(1964,CH.7),
  APPROXIMATION VON FUNKTIONEN UND IHRE NUMERISCHE BEHANDLUNG;
  "BEGIN" "INTEGER" NP1,K,POMK,COUNT,CNT,J,MI;
  "REAL" E,ABSE,ABSEH;
  NP1:=N+1;
  "BEGIN"
  "INTEGER" "ARRAY" S[0:NP1];
  "ARRAY" X,B,COEF[0:NP1]
  ,G[0:M];
 
                                                           "COMMENT"
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 7
                                                                  ;
 
 
  "PROCEDURE" ERRPOL(N,M,E,CO,S,Y,FY,G);
  "VALUE" N,M,E;"INTEGER" N,M;
  "REAL" E;
  "INTEGER" "ARRAY" S;"ARRAY" CO,Y,FY,G;
 "COMMENT"ERRPOL DELIVERS THE VALUE OF
 CO[0]+CO[1]*Y[I]+...+CO[N]*Y[I]**N - FY[I]
 IN G[I] FOR I=0,1,...M AND I NOT EQUAL S[J],J=0,1,...N+1.
 FOR J=0,1,...N+1 THEN G[S[J]]:=(-1)**J*E.
 THE INTEGERS S[J],FOR J=0,1,...N+1 ARE A SUBSET OF 0,1,...M;
  "BEGIN" "INTEGER" J,K,NP1,SJM1,SJ,S0,UP;
  NP1:=N+1;S0:=SJM1:=S[0];
  G[S0]:=E;
  "FOR" J:=1 "STEP" 1 "UNTIL" NP1 "DO"
  "BEGIN" SJ:=S[J];UP:=SJ-1;
  "FOR" K:= SJM1+1 "STEP" 1 "UNTIL" UP "DO"
     G[K]:=FY[K]-POL(N,Y[K],CO);
  G[SJ]:=E:=-E;
  SJM1:=SJ;
  "END" J;
  "FOR" K:= S0-1 "STEP"-1 "UNTIL" 0 "DO"
     G[K]:=FY[K]-POL(N,Y[K],CO);
  "FOR" K:= SJ+1 "STEP" 1 "UNTIL" M "DO"
     G[K]:=FY[K]-POL(N,Y[K],CO);
  "END" ERRPOL;
 
  INI(NP1,M,S);
  MI:=EM[2];
  ABSE:= 0;
  "FOR" COUNT:= 1, COUNT + 1 "WHILE" COUNT <= MI & ABSE > ABSEH "DO"
  "BEGIN"
  POMK:=1;
  "FOR" K:= 0 "STEP" 1 "UNTIL" NP1 "DO"
  "BEGIN" X[K]:= Y[S[K]]; COEF[K]:= FY[S[K]]; B[K]:= POMK;
      POMK:=-POMK "END";
  NEWTON(NP1,X,COEF); NEWTON(NP1,X,B);
  EM[0]:=
  E:= COEF[NP1]/B[NP1];
  ELMVEC(0,N,0,COEF,B,-E);
  NEWGRN(N,X,COEF);
  ERRPOL(N,M,E,COEF,S,Y,FY,G);
  SNDREMEZ(NP1,M,S,G,EM);
     ABSEH:=ABSE;     ABSE:=ABS(E);
  CNT:=COUNT;
  "END" WHILE COUNT;
  EM[2]:=MI;
  EM[3]:=CNT;
  DUPVEC(0,N,0,CO,COEF);
  "END";
  "END" MINMAXPOL
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 8
 
 
                                                                   ;
         "EOP"
 "CODE"36020;
 "PROCEDURE" INI(N,M,S);
 "VALUE" N,M;"INTEGER" N,M;
 "INTEGER" "ARRAY" S;
  "COMMENT" INI DELIVERS (MONOTONE) THE ROUNDED VALUES
  OF THE ARGUMENTS,WHERE THE CHEBYSHEV POLYNOMIAL
    OF DEGREE N(TRANSFORMED TO THE INTERVAL [0,M],M>=N)
  ATTAINS ITS MAXIMUM VALUES,
  IN INTEGER ARRAY S[0:N];
 "BEGIN""INTEGER"I,J,K,L;"REAL"PIN2;
     PIN2:=ARCTAN(1)*2/N;
     K:=0;L:=N-1;J:=S[0]:=0;S[N]:=M;
  "FOR" K:=K+1 "WHILE" K <  L "DO"
     "BEGIN"I:=SIN(K*PIN2)**2*M;
         J:=S[K]:="IF"I<=J"THEN"J+1"ELSE"I;
         S[L]:=M-J;L:=L-1
 "END"K;
 "IF"L*2=N"THEN"S[L]:=M/2;
  "END" INI;
         "EOP"
 
 
 "CODE"36021;
  "PROCEDURE" SNDREMEZ(N,M,S,G,EM);
  "VALUE" N,M;"INTEGER" N,M;
  "INTEGER" "ARRAY" S; "ARRAY" G,EM;
  "COMMENT" SNDREMEZ EXCHANGES ATMOST N+1 NUMBERS ,GIVEN IN
            INTEGER ARRAY S[0:N], WITH NUMBERS OUT OF THE
            REFERENCE SET 0,...M, UNDER THE CONDITIONS:
       I.   THE ALTERNANCE PROPERTY OF THE FUNCTIONVALUES G[S[J]],
            J=0,...N IS PRESERVED.
       II.  !G[S[J]]!>=!EM[0]!,J=0,...N.
       III. THE FIRST INDEX K , WITH G[K]=INFINITY NORM OF G,
            IS ONE OF THE RESULTING NUMBERS S[0],...S[N].
            IN ARRAY G[0:M] ONE MUST GIVE ERROR FUNCTION VALUES.
            MOREOVER,
            EM[1]:=INFINITY NORM OF G,
       THE PROCEDURE INFNRMVEC IS USED;
  "BEGIN" "INTEGER" S0,SN,SJP1,I,J,K,UP,INDEXMAX,LOW,NM1;
     "REAL" MAX,MSJP1,HI,HJ,HE,ABSE,H;
      INDEX MAX:=S0:=SJP1:=S[0];
      HE:=EM[0];LOW:=S0+1;
      MAX:=MSJP1:=ABSE:=ABS(HE);
      NM1:=N-1;
                                                               "COMMENT"
1SECTION : 7.1.3.2.1          (NOVEMBER 1978)                     PAGE 9
                                                                  ;
 
 
      "FOR" J:= 0 "STEP" 1 "UNTIL" NM1 "DO"
      "BEGIN"
         UP:= S[J+1]-1;
         H:= INFNRMVEC(LOW,UP,I,G);
         "IF" H > MAX  "THEN" "BEGIN" MAX:= H; INDEX MAX:= I "END";
         "IF" H > ABSE "THEN"
         "BEGIN" "IF" HE * G[I] > 0 "THEN"
            "BEGIN" S[J]:= "IF" MSJP1 < H "THEN" I "ELSE" SJP1;
               SJP1:= S[J+1]; MSJP1:= ABSE
            "END" "ELSE"
            "BEGIN" S[J]:= SJP1; SJP1:= I; MSJP1:= H "END"
         "END" "ELSE"
         "BEGIN" S[J]:=SJP1; SJP1:=S[J+1]; MSJP1:= ABSE "END";
         HE:=-HE;LOW:=UP+2;
     "END" FOR J; SN:= S[N]; S[N]:= SJP1;
 
     HI:=INFNRMVEC(0,S0-1,I,G);
     HJ:=INFNRMVEC(SN+1,M,J,G);
     "IF" J  > M  "THEN" J:=M;
     "IF" HI > HJ "THEN"
     "BEGIN" "IF" HI > MAX "THEN" "BEGIN" MAX:= HI; INDEXMAX:= I "END";
        "IF" SIGN(G[I]) =  SIGN(G[S[0]]) "THEN"
        "BEGIN" "IF" HI > ABS(G[S[0]])   "THEN"
           "BEGIN" S[0]:= I;
              "IF" G[J]/G[S[N]] > 1 "THEN" S[N]:=J
           "END"
        "END" "ELSE"
        "IF" HI > ABS(G[S[N]]) "THEN"
        "BEGIN" S[N]:= "IF" G[J]/G[S[NM1]] > 1  "THEN" J "ELSE" S[NM1];
           "FOR" K:= NM1 "STEP" -1 "UNTIL" 1 "DO" S[K]:= S[K-1];
           S[0]:= I
        "END"
     "END" "ELSE"
     "BEGIN" "IF" HJ > MAX "THEN" "BEGIN" MAX:= HJ; INDEXMAX:= J "END";
        "IF" SIGN(G[J]) = SIGN(G[S[N]]) "THEN"
        "BEGIN" "IF" HJ > ABS(G[S[N]])  "THEN"
           "BEGIN" S[N]:= J; "IF" G[I]/G[S[0]] > 1 "THEN"S[0]:=I "END"
        "END" "ELSE"
        "IF" HJ > ABS(G[S[0]]) "THEN"
        "BEGIN" S[0]:= "IF" G[I]/G[S[1]] > 1 "THEN" I "ELSE" S[1];
           "FOR" K:= 1 "STEP" 1 "UNTIL" NM 1 "DO" S[K]:= S[K+1];
           S[N]:= J
        "END"
     "END" RANDGEBIEDEN;
     EM[1]:=MAX;
  "END" SNDREMEZ;
         "EOP"