RootsEqns (Listing with comments)

LBL "RTEQNS"
2		# Number of equations. MUST BE CHANGED ACCORDING TO ACTUAL PROBLEM
STO "N"		# Preset number of equations
ENTER
DIM "MA"	# Create and dimention the matrix and arrays
1
DIM "VB"
DIM "VX"
DIM "VDX"
INPUT "XTOL"
INPUT "FTOL"
INPUT "MAX"
RCL "N"		# Calculate square root of N
SQRT
STO 12		# Store in R12
0
STO "ITR"	# Initialize number of iterations
XEQ 17		# Store display setting
XEQ 20		# Set I = 1 to N
LBL 19		# Start loop to prompt for array x ---------------------- 19
"X"
FIX 00
CF 29
ARCL "I"
|- "?"
XEQ 18		# Restore display
SF 29
PROMPT
XEQ 30		# Store input in X(I)
ISG "I"
GTO 19		# End of loop -------------------------------------------<19>

LBL 00		# Main loop ---------------------------------------------- 00
1
STO+ "ITR"
RCL "ITR"
RCL "MAX"
X<Y?
GTO 16		# Solution diverged -------------------------------------<16>
XEQ 20		# Set I = 1 to N
LBL 11		# Outer loop --------------------------------------------- 11
XEQ IND "I"	# Calculate function F<I>(x)
STO "FF"
XEQ 34		# Set F(I) = FF
XEQ 21		# Set J = 1 to N
CF 02
LBL 12		# Inner loop --------------------------------------------- 12
RCL "FF"
XEQ 32		# Set A(I,J) = FF
ISG "J"
GTO 12		# End of inner loop --------------------------------------<12>
ISG "I"
GTO 11		# End of outer loop --------------------------------------<11>

XEQ 20		# Set I = 1 to N
LBL 13		# Outer loop --------------------------------------------- 13		
XEQ 31		# Get X(I)
STO "XX"	# Set XX = X(I)
ABS
1
+
0.01
x
STO "H"		# Calculate and store H
RCL "XX"
+
XEQ 30		# X(I) = X(I) + H
XEQ 21		# Set J = 1 to N
SF 02
LBL 14		# Inner loop --------------------------------------------- 14
XEQ IND "J"
STO "FF"	# Calculate FF = F<J>(x)
XEQ 33		# Get A(J,I)
RCL "FF"
-
+/-
RCL "H"
/
XEQ 32		# Store A(J,I) = derivative of function I wrt X(J)
ISG "J"
GTO 14		# End of inner loop --------------------------------------<14>
CF 02
RCL "XX"
XEQ 30		# Restore X(I) = XX
ISG "I"
GTO 13		# End of outer loop --------------------------------------<13>

RCL "MA"
INVRT
RCL "VB"
x
STO "VDX"
STO- "VX"	# Set array x = array x - array delta x
FNRM		# Calculate vector norm
RCL 12
/
RCL "XTOL"
X>Y?
GTO 15		# ---------------------------------------------------------<15>
RCL "VB"
FNRM		# Calculate vector norm
RCL 12
/

RCL "FTOL"
X>Y?
GTO 15		# ---------------------------------------------------------<15>
GTO 00		# End of main loop ----------------------------------------<00>
LBL 16		# Handle case when exceeded max iterations ---------------- 16
"ITERS EXCEEDED"
PROMPT
LBL 15
CLV "H"		# Clear local variables
CLV "XX"
CLV "FF"
CLV "I"
CLV "J"
PRV "VX"	# Print the array of guesses
RCL "VX"	# Recall array of guesses onto the stack
EDIT 		# View array of guesses
BEEP
RTN

LBL 20		# Set I = 1 to N ----------------------------------------- 20
1
RCL "N"
1E3
/
+
STO "I"
RTN

LBL 21		# Set J = 1 to N ----------------------------------------- 21
1
RCL "N"
1E3
/
+
STO "J"
RTN

LBL 30		# Store X(I) --------------------------------------------- 30
INDEX "VX"
RCL "I"
1
STOIJ
RCL ST Z
STOEL
RTN

LBL 31		# Recall X(I) -------------------------------------------- 31
INDEX "VX"
RCL "I"
1
STOIJ
RCLEL
RTN

LBL 32		# Store A(I,J) ------------------------------------------- 32
INDEX "MA"
RCL "I"
RCL "J"
FS? 02
X<>Y
STOIJ
RCL ST Z
STOEL
RTN

LBL 33		# Recall A(I,J) ------------------------------------------ 33
INDEX "MA"
RCL "I"
RCL "J"
FS? 02
X<>Y
STOIJ
RCLEL
RTN

LBL 34		# Store F(I) --------------------------------------------- 35
INDEX "VB"
RCL "I"
1
STOIJ
RCL ST Z
STOEL
RTN

LBL 35		# Recall F(I) -------------------------------------------- 35
INDEX "VB"
RCL "I"
1
STOIJ
RCLEL
RTN

LBL 17		# Switch display mode to showing integers ---------------- 17
CF 00		# Determine display mode (FIX, ENG, or SCI)
CF 01
FS? 40
SF 00
FS? 41
SF 01
0		# Determine the number of digits displayed
STO 11
1
FS? 39
STO+ 11
2
FS? 38
STO+ 11
4
FS? 37
STO+ 11
8
FS? 36
STO+ 11		# Store number of digits in R08
RTN

LBL 18		# Restore display mode --------------------------------------- 18
SF 29		# Show decimal point
SCI IND 11	# Set to SCI mode by default
FS? 00		# Was it in FIX mode?
FIX IND 11
FS? 01		# Was it in ENG mode?
ENG IND 1
RTN

LBL 01		# Calculate function F1(x) = x(1)^2 + x(2)^2 - 1
XEQ 36		# Copy array X into registers
RCL 01
X^2
RCL 02
X^2
+
1
-
RTN

LBL 02		# Calculate function F2(x) = x(1)^2 - x(2)^2 + 0.5
XEQ 36		# Copy array X into registers
RCL 01
X^2
RCL 02
X^2
-
0.5
+
RTN

LBL 36		# Copy array X in registers 01 and up ----------------------- 36
INDEX "VX"
RCLEL
STO 01
I+
RCLEL
STO 02
RTN
.END.

--------------------
Namir Shammas
Program Version 1.0.0
Documentation Version 1.1.0
June 1, 2005
hp41cxcalc@aol.com