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: ; THE INDEPENDENT VARIABLE; A: ; THE INITIAL VALUE OF X; B: ; THE END VALUE OF X, (B <= A IS ALLOWED); Y: ; THE DEPENDENT VARIABLE; EXIT : THE VALUE OF Y(X) AT X = B; YA: ; ENTRY : THE INITIAL VALUE OF Y AT X = A, Z: ; THE DERIVATIVE DY / DX; EXIT : THE VALUE OF Z(X) AT X = B; ZA: ; ENTRY : THE INITIAL VALUE OF (D/DX) Y AT X = A; FXYZ: ; 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" 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" 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: ; 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: ; THE INDEPENDENT VARIABLE. UPON COMPLETION OF A CALL OF RK2N, IT IS EQUAL TO B; A: ; THE STARTING VALUE OF X; B: ; A VALUE PARAMETER,GIVING THE END VALUE OF X; Y: ; "ARRAY" Y[1:N]; THE VECTOR OF DEPENDENT VARIABLES; EXIT: THE VALUE OF Y[J] (B), (J = 1, .. ,N); YA: ; "ARRAY" YA[1:N]; ENTRY : THE STARTING VALUES OF Y[J],I.E. THE VALUES AT X=A; Z: ; "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" ZA[1:N]; ENTRY : THE STARTING VALUES OF Z[J],I.E. THE VALUES AT X=A; FXYZJ:; AN EXPRESSION DEPENDING ON X,J,Y[J],Z[J] (J=1,...,N), GIVING THE VALUE OF (D/DX)(D/DX)Y[J]; J: ; 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" 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" 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: ; 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: ; 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: ; THE INDEPENDENT VARIABLE. UPON COMPLETION OF A CALL OF RK3 , IT IS EQUAL TO B; A: ; THE STARTING VALUE OF X; B: ; A VALUE PARAMETER, GIVING THE END VALUE OF X; B <= A IS ALLOWED; Y: ; THE DEPENDENT VARIABLE; EXIT : THE VALUE OF Y(X) AT X = B; YA: ; ENTRY : THE VALUE OF Y AT X=A; Z: ; THE DERIVATIVE DY/DX; EXIT : THE VALUE OF DY/DX AT X = B; ZA: ; ENTRY : THE VALUE OF DY/DX AT X=A; FXY: ; AN EXPRESSION,DEPENDING ON X AND Y ,GIVING THE VALUE OF (D/DX)(D/DX)Y; E: ; "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" 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: ; 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: ; THE INDEPENDENT VARIABLE. UPON COMPLETION OF A CALL OF RK3N, IT IS EQUAL TO B; A: ; THE STARTING VALUE OF X; B: ; A VALUE PARAMETER,GIVING THE END VALUE OF X; B <= A IS ALLOWED. Y: ; "ARRAY" Y[1:N]; THE VECTOR OF DEPENDENT VARIABLES; EXIT : THE VALUE OF Y[J](X) AT X = B; YA: ; "ARRAY" YA[1:N]; ENTRY : THE STARTING VALUES OF Y[J],I.E. THE VALUES AT X=A; Z: ; "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" ZA[1:N]; ENTRY : THE STARTING VALUES OF Z[J],I.E. THE VALUES AT X=A; FXYJ: ; AN EXPRESSION DEPENDING ON X,Y[1],...,Y[N],J, GIVING THE VALUE OF (D/DX)(D/DX)Y[J]; J: ; 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" 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" 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: ; 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: ; 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: ; THE INDEPENDENT VARIABLE T; ENTRY: THE INITIAL VALUE T0; EXIT : THE FINAL VALUE TE; TE: ; ENTRY: THE FINAL VALUE OF T; M: ; NUMBER OF COLUMNS OF U; N: ; NUMBER OF ROWS OF U; U: ; "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: ; 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: ; 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: ; 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: ; 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: 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: ; THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1; X: ; "ARRAY" X[0:N]; ENTRY: A = X[0] < X[1] < ... < X[N] = B IS A PARTITION OF THE INTERVAL [A,B]; Y: ; "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: ; THE HEADING OF P READS: "REAL" "PROCEDURE" P(X); "VALUE" X; "REAL" X; P(X) IS THE COEFFICIENT OF Y' IN (1); R: ; THE HEADING OF R READS: "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X; R(X) IS THE COEFFICIENT OF Y IN (1); F: ; 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: ; 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" 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 ; (II) P(X), R(X) AND F(X) ARE REQUIRED TO BE SUFFICIENTLY SMOOTH ON 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 ; 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 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 AND A POLYNOMIAL OF DEGREE LESS THAN OR EQUAL TO K (K = ORDER//2) ON EACH SEGMENT (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 ; 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: ; THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1; X: ; "ARRAY" X[0:N]; ENTRY: A = X[0] < X[1] < ... < X[N] = B IS A PARTITION OF THE SEGMENT [A,B]; Y: ; "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: ; THE HEADING OF R READS: "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X; R(X) IS THE COEFFICIENT OF Y IN (3); F: ; THE HEADING OF F READS: "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X; F(X) IS THE RIGHT HAND SIDE OF (3); ORDER: ; 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" 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: ; THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1; NC: ; IF NC = 0, CARTESIAN COORDINATES ARE USED; IF NC = 1, POLAR COORDINATES ARE USED; IF NC = 2, SPHERICAL COORDINATES ARE USED; X: ; "ARRAY" X[0:N]; ENTRY: A = X[0] < X[1] < ... < X[N] = B IS A PARTITION OF THE INTERVAL [A,B]; Y: ; "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: ; THE HEADING OF R READS: "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X; R(X) IS THE COEFFICIENT OF Y IN (1); F: ; 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: ; 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" 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 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 AND A POLYNOMIAL OF DEGREE LESS THAN OR EQUAL TO K (K = ORDER//2) ON EACH SEGMENT (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 ; 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: ; THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1; X: ; "ARRAY" X[0:N]; ENTRY: A = X[0] < X[1] < ... < X[N] = B IS A PARTITION OF THE INTERVAL [A,B]; Y: ; "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: ; THE HEADING OF Q READS: "REAL" "PROCEDURE" Q(X); "VALUE" X; "REAL" X; Q(X) IS THE COEFFICIENT OF Y' IN (1); R: ; THE HEADING OF R READS: "REAL" "PROCEDURE" R(X); "VALUE" X; "REAL" X; R(X) IS THE COEFFICIENT OF Y IN (1); F: ; 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: ; 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" 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 , 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 AND A POLYNOMIAL OF DEGREE LESS THAN OR EQUAL TO K (K = ORDER//2) ON EACH SEGMENT (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 ; 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: ; THE UPPER BOUND OF THE ARRAY X; N > 1; X: ; "ARRAY" X[0:N]; ENTRY: A = X[0] < X[1] < ... < X[N] = B IS A PARTITION OF THE INTERVAL [A,B]; Y: ; "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: ; 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: ; 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: ; 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: ; THE HEADING OF F READS: "REAL" "PROCEDURE" F(X); "VALUE" X; "REAL" X; F(X) IS THE RIGHT HAND SIDE OF (1); ORDER: ; 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" 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 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 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 AND A POLYNOMIAL OF DEGREE LESS THAN OR EQUAL TO K (K = 1 + ORDER//2) ON EACH CLOSED SEGMENT (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 ; 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 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; THE UPPER BOUND OF THE ARRAYS X AND Y; N > 1; NC: ; IF NC = 0, CARTESIAN COORDINATES ARE USED; IF NC = 1, POLAR COORDINATES ARE USED; IF NC = 2, SPHERICAL COORDINATES ARE USED; X: ; "ARRAY" X[0:N]; ENTRY: A = X[0] < X[1] < ... < X[N] = B IS A PARTITION OF THE SEGMENT [A,B]; Y: ; "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: ; 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: ; 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: ; 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" 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 (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" 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: ; LOWER AND UPPER BOUND FOR THE FIRST SUBSCRIPT OF U; LL,UL: ; LOWER AND UPPER BOUND FOR THE SECOND SUBSCRIPT OF U; INAP: ; 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: ; 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: ; 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: ; 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" 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: K COUNTS THE NUMBER OF ITERATIONS RICHARDSON IS PERFORMING; IT CAN SERVE AS A JENSEN PARAMETER FOR N AND OUT; RATECONV: ; AFTER EACH ITERATION THE AVERAGE RATE OF CONVERGENCE IS ASSIGNED TO RATECONV; DOMEIGVAL: ; 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: ; 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 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 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; "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: ; LOWER AND UPPER BOUND FOR THE FIRST SUBSCRIPT OF U; LL,UL: ; LOWER AND UPPER BOUND FOR THE SECOND SUBSCRIPT OF U; RESIDUAL: ; 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: ; A AND B SHOULD HAVE THE SAME VALUES AS IN THE PRECEDING CALL OF RICHARDSON (SEE DESCRIPTION OF RICHARDSON); N: ; THE NUMBER OF ITERATIONS THE PROCEDURE ELIMINATION NEEDS TO ELIMINATE THE EIGENFUNCTION BELONGING TO THE DOMINANT EIGENVALUE, IS ASSIGNED TO N; DISCR: ; "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: K COUNTS THE NUMBER OF ITERATIONS ELIMINATION IS PERFORMING IT CAN SERVE AS A JENSEN PARAMETER FOR OUT; RATECONV: ; 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: ; 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: ; 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= 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: ; THE NUMBER OF DIFFERENTIAL EQUATIONS; M: ; THE NUMBER OF UNKNOWN VARIABLES; NOBS: ; THE NUMBER OF OBSERVATIONS; NOBS SHOULD SATISFY NOBS>=M; NBP: ; 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" 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" 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: ; "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" 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" 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" 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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])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]); 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; THE REAL X OCCURING IN THE INTEGRAND. N: ; UPPER BOUND FOR THE INTEGER I OCCURING IN THE INTEGRAND; ALPHA: ; "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 : ; ENTRY: THE (REAL) POSITIVE X OCCURING IN THE INTEGRAND; N1, N2: ; ENTRY: LOWER AND UPPER BOUND, RESPECTIVELY, OF THE INTEGER N OCCURING IN THE INTEGRAND; A: ; "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: ; ENTRY: THE (REAL) POSITIVE X OCCURING IN THE INTEGRAND; N1, N2: ; ENTRY: LOWER AND UPPER BOUND, RESPECTIVELY, OF THE INTEGER I OCCURING IN THE INTEGRAND; A: ; "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 NN0. 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=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 : ; ENTRY: THE (REAL) ARGUMENT OF SI(X) AND CI(X); SI: ; EXIT: THE VALUE OF SI(X); CI: ; 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: ; ENTRY: THE (REAL) ARGUMENT OF F(X) AND G(X); F: ; EXIT: THE VALUE OF F(X); G: ; 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: ; 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: ; 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: ; 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: ; 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: ; 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: ; THE INDEPENDENT ARGUMENT X, X>=0; A: ; THE INDEPENDENT PARAMETER A, A>0; KLGAM: ; EXIT: THE INTEGRAL FROM 0 TO X OF EXP(-T)*T**(A-1)*DT IS DELIVERED IN KLGAM; GRGAM: ; EXIT: THE INTEGRAL FROM X TO INFINITY OF EXP(-T)* T**(A-1)*DT IS DELIVERED IN GRGAM; GAM: ; ENTRY: THE VALUE OF THE GAMMAFUNCTION WITH ARGUMENT A. FOR THIS EXPRESSION THE "REAL" "PROCEDURE" GAMMA(X); "CODE" 35061 MAY BE USED; EPS: ; 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: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY 0<=X<=1; P: ; PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; P>0; Q: ; PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; Q>0; EPS: ; 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: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY 0<=X<=1; P: ; PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; P>0. IT IS ADVISED TO TAKE 0; PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; Q>0; NMAX: ; NMAX INDICATES THE MAXIMUM NUMBER OF FUNCTION VALUES I(X,P+N,Q) TO BE GENERATED; EPS: ; ENTRY: THE DESIRED RELATIVE ACCURACY; EPS SHOULD NOT BE SMALLER THAN THE MACHINE ACCURACY; I: ; "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: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY 0<=X<=1; P: ; PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; P>0; Q: ; PARAMETER: SEE DEFINITION IN BRIEF DESCRIPTION; Q>0; IT IS ADVISED TO TAKE 0; NMAX INDICATES THE MAXIMUM NUMBER OF FUNCTION VALUES I(X,P,Q+N) TO BE GENERATED; EPS: ; ENTRY: THE DESIRED RELATIVE ACCURACY; EPS SHOULD NOT BE SMALLER THAN THE MACHINE ACCURACY; I: ; "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: ; ENTRY: THE (REAL) ARGUMENT OF ERF(X) AND ERFC(X); ERF: ; EXIT: THE VALUE OF ERF(X), ERFC: ; 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: ; 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: ; 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: ; 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: ; 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: ; ENTRY: THE (REAL) ARGUMENT OF C(X) AND S(X); C: ; EXIT: THE VALUE OF C(X); S: ; 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: ; ENTRY: THE (REAL) ARGUMENT OF F(X) AND G(X); F: ; EXIT: THE VALUE OF F(X); G: ; 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: ; 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: ; 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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; N: ; THE UPPER BOUND OF THE INDICES OF ARRAY J; N >= 0; J: ; "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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0; Y0: ; EXIT: Y0 HAS THE VALUE OF THE ORDINARY BESSEL FUNCTION OF THE SECOND KIND OF ORDER 0 AND ARGUMENT X; Y1: ; 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: ; THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X > 0; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY Y; N >= 0; Y: ; "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: ; THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X > 0; P0: ; EXIT: P0 CORRESPONDS WITH THE FUNCTION P(X,0) DEFINED IN [1,FORMULAS 9.2.5 AND 9.2.6]; Q0: ; 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: ; THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X > 0; P1: ; EXIT: P1 CORRESPONDS WITH THE FUNCTION P(X,1) DEFINED IN [1,FORMULAS 9.2.5 AND 9.2.6]; Q1: ; 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: ; 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: ; 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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY I; I: ; "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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0; K0: ; EXIT: K0 HAS THE VALUE OF THE MODIFIED BESSEL FUNCTION OF THE THIRD KIND OF ORDER 0 WITH ARGUMENT X; K1: ; 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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N >= 0; K: ; "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: ; 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: ; 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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY I; N >= 0; I: ; "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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0; K0: ; 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: ; 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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N >= 0; K: ; "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: ; THE ORDER; X: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0; YA: ; EXIT: THE NEUMANN FUNCTION OF ORDER A AND ARGUMENT X; YA1: ; 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=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: ; THE ORDER; X: ; THE ARGUMENT; THIS ARGUMENT SHOULD SATISFY X>0; NMAX: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY YAN; YAN: ; "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: ; THE ORDER; X: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0; PA: ; 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: ; 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: ; EXIT: THE FUNCTION P(X, A+1); QA1: ; 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: ; THE ORDER OF THE BESSEL FUNCTION, A>=0. N: ; THE NUMBER OF ZEROS TO BE EVALUATED, N>=1. Z: ; "ARRAY" Z[1:N]; EXIT: Z[J] IS THE J-TH ZERO OF THE SELECTED BESSEL FUNCTON; D: ; 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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS, X > 0; N: ; THE NUMBER OF BESSEL FUNCTIONS TO BE COMPUTED, N >= 0; T: ; 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*N0 "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 = 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: ; THE ORDER; X: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0; KA: ; EXIT: THE VALUE OF THE MODIFIED BESSEL FUNCTION OF THE THIRD KIND OF ORDER A AND ARGUMENT X; KA1: ; 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=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: ; THE ORDER. IT IS ADVISED TO TAKE A >= 0; X: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0; NMAX: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY KAN; KAN: ; "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: ; THE ORDER; X: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0; KA: ; 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: ; 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=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: ; THE ORDER. IT IS ADVISED TO TAKE A >= 0; X: ; THE ARGUMENT. THIS ARGUMENT SHOULD SATISFY X>0; NMAX: ; THIS PARAMETER SHOULD SATISFY NMAX>=0; NMAX INDICATES THE MAXIMUM NUMBER OF FUNCTION VALUES TO BE GENERATED; KAN: ; "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*N0 "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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X >= 0; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY I; N >= 0; I: ; "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: ; THE ARGUMENT OF THE BESSEL FUNCTIONS; X > 0; N: ; THE UPPER BOUND OF THE INDICES OF THE ARRAY K; N >= 0; K: ; "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: ; ENTRY : THE REAL ARGUMENT OF THE AIRY FUNCTIONS. AI: ; EXIT : THE VALUE OF THE AIRY FUNCTION AI IS GIVEN BY : EXP( -EXPON ) * AI. NOTE : IF X < 9 THEN EXPON = 0. AID: ; 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: ; EXIT : THE VALUE OF THE AIRY FUNCTION BI IS GIVEN BY : EXP( EXPON ) * BI. NOTE : IF X < 9 THEN EXPON = 0. BID: ; 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: ; EXIT : IF X < 9 THEN 0 ELSE 2/3 * X ** (3/2). FIRST: ; 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 : ; ENTRY : THE NUMBER OF ZEROS TO BE CALCULATED; D : ; ENTRY : AN INTEGER WHICH SELECTS THE REQUIRED AIRY FUNCTION. D = 0, 1, 2 OR 3. ZAI : ; "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" 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: ; THE DEGREE OF THE POLYNOMIAL; X: ; "ARRAY"X[0:N]; ENTRY: THE INTERPOLATION POINTS; F: ; "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: ; THE DEGREE OF THE APPROXIMATING POLYNOMIAL (N>=0); M: ; THE NUMBER OF REFERENCE FUNCTION VALUES VIZ. ARGUMENTS IS M+1; Y,FY: ; "ARRAY"Y,FY[0:M]; ENTRY: FY[I] IS THE FUNCTION VALUE AT Y[I], FOR I=0,...M; CO: ; "ARRAY"CO[0:N]; EXIT: THE COEFFICIENTS OF THE APPROXIMATING POLYNOMIAL (CO[N] IS COEFFICIENT OF Y**N); EM: ; "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: ; THE NUMBER OF POINTS TO BE SELECTED EQUALS N+1; THE REFERENCE SET CONTAINS THE NUMBERS 0,1,...,M (M>=N); S: ; "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: ; 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: ; "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" G[0:M]; ENTRY: IN ARRAY G[0:M] ONE MUST GIVE FUNCTION VALUES; EM: ; "ARRAY" EM[0:1]; ENTRY: 0 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"