Forgot your password?
Document Actions
newnumal5p3.txt. May 13, 1992.
The set of plaintext ASCII files numalinx.txt newnumal5p1.txt newnumal5p2.txt newnumal5p3.txt together contains an update of the index and manual of the library NUMAL of Algol 60 procedures in numerical mathematics as published in the Mathematical Centre publication: P.W. Hemker (ed.)[1981]: NUMAL. Numerical Procedures in ALGOL 60. 7 volumes. MC Syllabus 47, Mathematical Centre, Amsterdam.
Size 462.7 kB - File type text/plain
Click here to get the file
File contents
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"