########################################################################### ########################################################################### Index: 1SECTION : 5.2.1.1.2.1.A THE SCALAR INITIAL VALUE PROBLEM 1SECTION : 5.2.1.1.2.1.B THE VECTOR INITIAL VALUE PROBLEM 1SECTION : 5.2.1.1.2.1.C THE SCALAR INITIAL VALUE PROBLEM 1SECTION : 5.2.1.1.2.1.D THE VECTOR INITIAL VALUE PROBLEM 1SECTION : 5.2.1.1.3 AN INITIAL VALUE PROBLEM, GIVEN AS A SYSTEM OF FIRST ORDER (NON-LINEAR) DIFFERENTIAL EQUATIONS BY MEANS OF A STABILIZED RUNGE KUTTA METHOD; 1SECTION : 5.2.1.2.1.2.1.1 SOLUTION OF SECOND ORDER SELF-ADJOINT LINEAR TWO POINT BOUNDARY VALUE PROBLEMS; 1SECTION : 5.2.1.2.1.2.1.2 SOLUTION OF SECOND ORDER SKEW-ADJOINT LINEAR TWO POINT BOUNDARY VALUE PROBLEMS; 1SECTION : 5.2.1.2.1.2.2.1 SOLUTION OF FOURTH ORDER SELF-ADJOINT LINEAR TWO POINT BOUNDARY VALUE PROBLEMS; 1SECTION : 5.2.1.2.1.3 A NONLINEAR TWO POINT BOUNDARY VALUE PROBLEM WITH SPHERICAL COORDINATES 1SECTION : 5.2.1.2.2.1.2 A SYSTEM OF LINEAR EQUATIONS WITH A COEFFICIENT MATRIX HAVING POSITIVE REAL EIGENVALUES BY MEANS OF A NON-STATIONARY SECOND ORDER ITERATIVE METHOD 1SECTION : 5.2.1.3.1 ESTIMATES UNKNOWN VARIABLES IN A SYSTEM OF FIRST ORDER DIFFERENTIAL EQUATIONS 1SECTION : 6.1 DELIVERS THE VALUE OF PI and E 1SECTION : 6.2 THE ARITHMETIC OF THE COMPUTER 1SECTION : 6.4.1 TAN, ARCSIN, ARCCOS 1SECTION : 6.4.2 hyperbolic functions 1SECTION : 6.4.3 COMPUTATION OF LN(1+X) FOR X > -1 1SECTION : 6.5.1 exponential integrals 1SECTION : 6.5.2 THE SINE INTEGRAL SI(X) AND THE COSINE INTEGRAL CI(X) 1SECTION : 6.6 The gamma function 1SECTION : 6.7 The error function 1SECTION : 6.9.1 BESSEL FUNCTION OF THE FIRST KIND and THE SECOND KIND 1SECTION : 6.9.2 Modified BESSEL FUNCTIONs 1SECTION : 6.10.1 BESSEL FUNCTIONs 1SECTION : 6.10.2 Modified BESSEL FUNCTIONs 1SECTION : 6.10.3 Spherical BESSEL FUNCTIONs 1SECTION : 6.10.4 THE EVALUATION OF AIRY FUNCTIONS AND COMPUTING THEIR ZEROS 1SECTION : 7.1.1.1.1 THE COEFFICIENTS OF THE NEWTON POLYNOMIAL THROUGH GIVEN INTERPOLATION POINTS 1SECTION : 7.1.3.2.1 THE COEFFICIENTS OF THE POLYNOMIAL(AS A SUM OF POWERS) WHICH APPROXIMATES A FUNCTION, GIVEN FOR DISCRETE ARGUMENTS ########################################################################### ########################################################################### 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) 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. 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. 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=+.0000000 X=18.8630540500 Y=+02.0142853609 DY/DX=-.0000100 X=28.4022416200 Y=-02.0142853609 DY/DX=+.0000100 X=37.9414291800 Y=+02.0142853608 DY/DX=-.0000200 SOURCE TEXT(S): 0CODE 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; 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 NOTLAST 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) 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. 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]; 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]. 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])+(IFK=1THENY[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 SOURCE TEXT(S): 0CODE 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; 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; 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 NOTLAST 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) 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. 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. 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 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): 0CODE 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; 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 NOTLAST 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) 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; 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. 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: 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,IFK=1THENY[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])=.000000000500 ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.000000001800 ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.000000004600 ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.000000012600 ABS(YEXACT[1]-Y[1])+ABS(YEXACT[2]-Y[2])=.000000029300 SOURCE TEXT(S): 0CODE 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; 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; 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 NOTLAST 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) 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; 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. 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. 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; 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 SOURCE TEXT(S): 0CODE 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: FORLBD:=.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; 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) 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]. 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). 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); 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. 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 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. 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. 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: 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. 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); 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; 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 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. SOURCE TEXT(S): 0CODE 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; 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; 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 0CODE 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 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; 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; 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; 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; 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; 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) 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). 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); 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. 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: 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. SOURCE TEXT(S): 0CODE 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 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; 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) 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). 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; 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 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: 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 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. SOURCE TEXT(S): 0CODE 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; IFORDER=4THEN 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 REALP3, Q3, R3, F3; H:= XL - XL1; H2:= H*H; H3:= H*H2; X2:= (XL1 + XL)/2; IFL=1THEN BEGINP3:= 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; 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 IFORDER=6THEN BEGIN OWN REALP4, Q4, R4, F4; REALH, 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; IFL=1THEN BEGINP4:= 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 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 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 REALP5, 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; IFL=1THEN BEGINP5:= 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 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 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 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; ENDEL.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; FORL:= L + 1WHILEL; 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); 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); 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: 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. SOURCE TEXT(S): 0CODE 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.; 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; BEGINPP:= 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; 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) 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. 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); 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; INTEGERK; 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. 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; 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; INTEGERK; 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; EOP CODE33171; 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) 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; 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; 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; 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; 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]; 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. 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. 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; INTEGERARRAY 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]); 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 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; INTEGERARRAY 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 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; 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: 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 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 SOURCE TEXT(S): 0CODE 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 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 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; 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; 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; 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; 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; 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; 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 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. 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 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) 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. 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 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 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 SOURCE TEXTS: 0CODE 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) 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. 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). 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. BEGINREAL 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 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 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 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 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 SOURCE TEXTS : 0CODE 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 REALAX; 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; 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 0CODE 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) 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. 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) 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. 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). 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. 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) 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. 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 SOURCE TEXT(S): 0CODE 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; 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; 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 0CODE 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; 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; EOP 0CODE 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) 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). 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. 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 SOURCE TEXT(S): 0CODE 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; EOP 0CODE 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) 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. 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. 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. 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 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) . 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. 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. 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. 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. 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. 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. 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; 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. SOURCE TEXT(S) : 0CODE 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 0CODE 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; EOP 0CODE 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; EOP 0CODE 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; EOP 0CODE 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:= TRUEEND 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 0CODE 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; EOP 0CODE 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 0CODE 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; EOP 0CODE 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 0CODE 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; EOP 0CODE 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 BEGINFOR 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) 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); 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. 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). 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). 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. 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. 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 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). 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. 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 SOURCE TEXT(S) : 0CODE 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 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; EOP 0CODE 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 0CODE 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 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 0CODE 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 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) 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. 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. 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. 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; 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 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 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. 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. 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. 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; 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; REALX; 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 BEGINREAL 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, -.274474305529745DO 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; 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- 0DO 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 577031; 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; 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; 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) 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); 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. 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 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]. 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. 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 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). 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. 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 .9244190712280 .1656441120001 .7550183551241 1.0 .4210244382410 .6019072301970 .1624838898641 1.5 .2138055626480 .2773878004570 .5836559632570 2.0 .1138938727500 .1398658818170 .2537597545660 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. 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. 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 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 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. 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; 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.14DD)),X,K) END END PRINTS THE FOLLOWING RESULTS: .5 .152410938577391 .273100970821181 .124481482186212 1.0 .114446307980691 .163615348626331 .441677005233341 1.5 .958210053294960 .124316587355251 .261576455136491 2.0 .841568215070780 .103347684706871 .187504506213951 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; 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; 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); 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; 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; 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) 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. 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; 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 .573061269283640 .41529475124424 0 .16616338793111 0 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). 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. 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; 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. 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. 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 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. 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 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 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 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; ; 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.; BEGINREAL 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; 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=1ORD=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=0ANDS=1ANDD=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 ANDJ<5 THEN GOTO L1 END; Z[S]:=X END END BESS ZEROS; EOP CODE 35185; INTEGER PROCEDURE START(X,N,T); VALUE X,N,T; REAL X; INTEGER N,T; BEGIN REALP,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; 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; 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 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. 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. 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. 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; 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. 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. 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. 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 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; 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 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) 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; 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. 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 .664996657736030 .39617297071220 .127349283688410 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; 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: .157079632711 .20000000001 -.6223649549-13 -.63661977240 -.12158542041 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]. 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. 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). 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 .106292082896910 .106292082896910 1 .159438124345360 .159438124345360 2 .345449269414950 .345449269414940 3 .102306129788281 .102306129788281 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. SOURCE TEXT(S): 0CODE 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; 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; 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) 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. 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. 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 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. 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 SOURCE TEXT(S): 0CODE 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; 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; EOP 0CODE 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) 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); VALUEN;INTEGERN;ARRAYX,F; CODE 36010; THE MEANING OF THE FORMAL PARAMETERS IS: N: ; THE DEGREE OF THE POLYNOMIAL; X: ; ARRAYX[0:N]; ENTRY: THE INTERPOLATION POINTS; F: ; ARRAYF[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. 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]); ENDTSTNEWTON THE NEWTON COEFF. ARE +1.0000000000000+000 -2.0000000000000+000 +2.0000000000000+000 SOURCE TEXT(S): CODE36010; 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) 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. SUBSECTION : MINMAXPOL. CALLING SEQUENCE: THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS: PROCEDUREMINMAXPOL(N,M,Y,FY,CO,EM); VALUEN,M;INTEGERN,M;ARRAYY,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: ; ARRAYY,FY[0:M]; ENTRY: FY[I] IS THE FUNCTION VALUE AT Y[I], FOR I=0,...M; CO: ; ARRAYCO[0:N]; EXIT: THE COEFFICIENTS OF THE APPROXIMATING POLYNOMIAL (CO[N] IS COEFFICIENT OF Y**N); EM: ; ARRAYEM[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. METHOD AND PERFORMANCE: SEE MEINARDUS (1969),CH.7. EXAMPLE OF USE: BEGININTEGERN; PROCEDURE COMPUTE(N,A,B,F); VALUE N,A,B;INTEGER N;REAL A,B; REAL PROCEDURE F; BEGIN INTEGER K,L,M; REALR,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; FORK:=1STEP1UNTILLDO BEGINR:=Y[K]:=A+K*IDM;FY[K]:=F(R) END; MINMAXPOL(N,M,Y,FY,COEF,EM); OUTPUT(61,((COEF:)/)); FORK:=0STEP1UNTILNDOOUTPUT(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; REALPROCEDUREF(X);VALUEX;REALX; F:=1/(X-10); FOR N:=1DO 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 SUBSECTION : INI. CALLING SEQUENCE: THE DECLARATION OF THE PROCEDURE IN THE CALLING PROGRAM READS: PROCEDURE INI(N,M,S); VALUEN,M;INTEGERN,M;INTEGERARRAYS; 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: BEGININTEGERARRAYS[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: PROCEDURESNDREMEZ(N,M,S,G,EM); VALUEN,M;INTEGERN,M;INTEGERARRAYS;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); 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; EOP CODE36020; 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]; BEGININTEGERI,J,K,L;REALPIN2; 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 BEGINI:=SIN(K*PIN2)**2*M; J:=S[K]:=IFI<=JTHENJ+1ELSEI; S[L]:=M-J;L:=L-1 ENDK; IFL*2=NTHENS[L]:=M/2; END INI; EOP CODE36021; 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; 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 THENS[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