LBL SCAN GTO A LBL E # Calculate f(x) LBL 00 EXP LASTX X^2 3 * - RTN LBL 05 # Calculate & store h = 0.001*(1 + ABS(X)) ABS 1 + .001 * STO 22 RTN LBL 01 # Calculate f'(x) given x and f(x) in X and Y registers STO 21 X<>Y STO 23 X<>Y XEQ 05 # Calculate h RCL 21 + # Calculate x+h XEQ 00 # Calculate f(x+h) RCL 23 - RCL 22 / # Calculate (f(x+h) - f(x))/ h RTN LBL 02 # Calculate f''(x) given x STO 21 XEQ 05 # Calculate h RCL 21 XEQ 00 # Calculate f(x) STO 23 RCL 21 RCL 22 + XEQ 00 # Calculate f(x+h) STO 24 RCL 21 RCL 22 - XEQ 00 # Calculate f(x-h) STO 25 RCL 24 + RCL 23 STO+ X - RCL 22 X^2 / # Calculate (f(x+h) - 2*f(x) + f(x-h))/h^2 RTN LBL 03 # Calculate the root of f(x) using Newton's method STO 21 LBL 17 # ----------------- start of itearions loop RCL 21 XEQ 05 # Calculate h RCL 21 XEQ 00 # Calculate f(x) STO 23 RCL 21 RCL 22 + XEQ 00 # Calculate f(x+h) RCL 23 - RCL 23 X<>Y / RCL 22 * # Calculate diff = h * f(x)/(f(x+h) - f(x)) STO- 21 # Calculate X = X - diff ABS RCL 05 XY STO 02 "STEP?" 0.1 PROMPT STO 04 "TOLER?" 1E-6 PROMPT STO 05 "FXTOLER?" 1E-4 PROMPT STO 06 0 STO 07 # Initialize NumSteps RCL 02 STO 08 # Xa = A XEQ 00 # Calculate Fa STO 09 RCL 08 XEQ 01 # Calculate Da STO 10 SIGN # Calculate sign(Da) ST0 12 RCL 09 SIGN # Calculate sign(Fa) STO 11 LBL 06 # ------------------------------ MAIN LOOP CF 00 # Clear MOES flag 1 STO+ 07 # Increment NumSteps RCL 02 RCL 04 RCL 07 * + # Calculate Xb VIEW X STO 13 XEQ 00 # Calculate Fb STO 14 RCL 13 XEQ 01 # Calculate Db STO 15 SIGN # Calculate sign(Db) ST0 17 RCL 14 SIGN # Calculate sign(Fb) STO 16 RCL 14 X#0? # F(Xb) <> 0? GTO 07 SF 00 # Set MOEs flag "X=" # Xb is an exact root ARCL 13 PROMPT "FX=0" PROMPT RCL 12 RCL 17 * X>0? # SignDa * SignDb > 0 GTO 09 RCL 13 XEQ 02 # Calculate f''(Xb) STO 20 ABS RCL 06 X>Y? # FxToler>|f''(x)|? GTO 12 RCL 20 X>0? GTO 14 "ROOT/MAX" PROMPT GTO 09 LBL 14 "ROOT/MIN" PROMPT GTO 09 LBL 12 "ROOT/SADDLE" PROMPT GTO 09 LBL 07 # Xb is not root! RCL 11 RCL 16 * X>0? GTO 08 SF 00 # Set MOEs flag RCL 08 RCL 13 + 2 / # Calculate (Xa + Xb) / 2 and use it as initial guess for a root XEQ 03 # Calculate root using Newtn's method STO 00 "X=" ARCL 00 PROMPT RCL 00 XEQ 00 # Calculate Fx "FX=" ARCL X PROMPT GTO 09 LBL 08 RCL 12 RCL 17 * X<0? GTO 09 RCL 12 RCL 17 * X>0? GTO 09 SF 00 # Set MOES flag RCL 08 RCL 13 + 2 / # Calculate X = (Xa + Xb) / 2 and use it as initial guess for a root XEQ 04 # Calculate root of f'(X) using Newtn's method STO 00 "X=" ARCL X PROMPT RCL 00 XEQ 00 # Calculate f(x) “FX=” ARCL X PROMPT # Display f(x) CLA # Clear alpha register RCL 00 XEQ 00 # Calculate f(x) ABS RCL 06 X>Y? |-"ROOT/" # Append "root/" to alpha register and prepare for either min or max RCL 00 XEQ 02 # Calculate f''(x) STO 20 X>0? GTO 16 |-"MAX" # Append "max" to alpha register PROMPT GTO 09 LBL 16 |-"MIN" # Append "min" to alpha register PROMPT LBL 09 FC?C 00 # Is MOES flag clear? GTO 10 1 # Move search by one extra step STO+ 07 RCL 02 RCL 04 RCL 07 * + # Calculate Xa STO 08 XEQ 00 # Calculate Fa STO 09 RCL 08 XEQ 01 # Calculate Da STO 10 SIGN # Calculate sign(Da) ST0 12 RCL 09 SIGN # Calculate sign(Fa) STO 11 GTO 11 LBL 10 # Perform a regular step forward 13.017 ENTER 8.012 LBL 20 # Loop to copy register bloc RCL IND Y STO IND Y RDN ISG Y STO X ISG X GTO 20 LBL 11 RCL 03 RCL 08 # Xa < B? X