mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-03-02 17:44:40 +00:00
2c72f7fd1d
1. Commit library tape images, directories, and extracted text files. 2. Commit additional utilities under Unisys-Emode-Tools.
122 lines
8.6 KiB
Plaintext
122 lines
8.6 KiB
Plaintext
COMMENT THIS PROCEDURE SOLVES A SET OF N BY N SIMULTANEOUS LINEAR SLVE0010
|
|
EQUATIONS USING THE CROUT REDUCTION. PROVISION IS MADE SLVE0020
|
|
FOR EASILY SOLVING SEVERAL SETS OF SUCH EQUATIONS, THE SLVE0030
|
|
COEFFICIENT MATRIX OF WHICH REMAINS THE SAME. PROVISION SLVE0040
|
|
IS ALSO MADE FOR ITERATING THE SOLUTION TO REDUCE ROUND- SLVE0050
|
|
OFF ERROR. THIS FEATURE IS OPTIONAL. THE ORIGINAL SLVE0060
|
|
EQUATIONS MAY BE PERMUTED, BUT OTHERWISE REMAIN INTACT. SLVE0070
|
|
|
|
R.D. RODMAN, SLVE0080
|
|
(PROFESSIONAL SERVICES DIVISIONAL GROUP), SLVE0090
|
|
|
|
CARD SEQUENCE STARTS WITH SLVE0010. SLVE0100
|
|
FIRST RELEASED 12/01/62. ; SLVE0110
|
|
|
|
PROCEDURE SOLVE(N, A, C, RSW, E, K1, EPS, X, E1, E2) ; SLVE0130
|
|
VALUE N, RSW, E, K1, EPS ; SLVE0140
|
|
INTEGER N, K1 ; SLVE0150
|
|
REAL E, EPS ; SLVE0160
|
|
BOOLEAN RSW ; SLVE0170
|
|
REAL ARRAY A[0,0], C, X[0] ; SLVE0180
|
|
LABEL E1, E2 ; SLVE0190
|
|
BEGIN SLVE0200
|
|
INTEGER I, J, K, J1, K2, L ; SLVE0210
|
|
REAL BIG, TEMP, DIAG, NORM, Q ; SLVE0220
|
|
OWN INTEGER ARRAY F[0:N] ; SLVE0230
|
|
REAL ARRAY D[0:N] ; SLVE0240
|
|
OWN REAL ARRAY B[0:N, 0:N] ; SLVE0250
|
|
LABEL S1, S2, S3, S4, S5, S6, REP, S7, S8, S9, IT1, S10, S11, SLVE0260
|
|
S12, S13, S14, S15, EXIT ; SLVE0270
|
|
S1: IF RSW THEN GO TO REP ; SLVE0290
|
|
|
|
COMMENT THE COEFFICIENT MATRIX IS TRIANGULARIZED. ; SLVE0300
|
|
|
|
FOR I ~ 1 STEP 1 UNTIL N DO SLVE0310
|
|
FOR J ~ 1 STEP 1 UNTIL N DO SLVE0320
|
|
B[I,J] ~ A[I,J] ; SLVE0330
|
|
S2: FOR I ~ 1 STEP 1 UNTIL N DO SLVE0340
|
|
BEGIN SLVE0350
|
|
L ~ I-1 ; SLVE0360
|
|
FOR J ~ I STEP 1 UNTIL N DO SLVE0370
|
|
BEGIN SLVE0380
|
|
Q~0 ; SLVE0390
|
|
FOR K ~ 1 STEP 1 UNTIL L DO Q ~ B[J,K] | B[K,I] + Q ; SLVE0400
|
|
B[J,I] ~ B[J,I] - Q SLVE0410
|
|
END ; SLVE0420
|
|
BIG ~ 0 ; K2 ~ I ; SLVE0430
|
|
S3: FOR K ~ I STEP 1 UNTIL N DO SLVE0440
|
|
BEGIN SLVE0450
|
|
IF ABS(B[K,I]) > BIG THEN SLVE0460
|
|
BEGIN SLVE0470
|
|
BIG ~ ABS(B[K,I]) ; K2 ~ K SLVE0480
|
|
END SLVE0490
|
|
END ; SLVE0500
|
|
|
|
COMMENT E1 IS THE NON-LOCAL LABEL TO WHICH AN EXIT IS MADE IF THE SLVE0510
|
|
COEFFICIENT MATRIX IS SINGULAR. ; SLVE0520
|
|
|
|
S4: IF BIG { EPS THEN GO TO E1 ; F[I] ~ K2 ; SLVE0530
|
|
IF K2 ! I THEN SLVE0540
|
|
S5: FOR K ~ 1 STEP 1 UNTIL N DO SLVE0550
|
|
BEGIN SLVE0560
|
|
TEMP ~ A[K2,K] ; A[K2,K] ~ A[I,K] ; A[I,K] ~ TEMP ; SLVE0570
|
|
TEMP ~ B[K2,K] ; B[K2,K] ~ B[I,K] ; B[I,K] ~ TEMP ; SLVE0580
|
|
END ; SLVE0590
|
|
DIAG ~ B[I,I] ; SLVE0600
|
|
S6: FOR J ~ I+1 STEP 1 UNTIL N DO SLVE0610
|
|
BEGIN SLVE0620
|
|
Q~0 ; SLVE0630
|
|
FOR K ~ 1 STEP 1 UNTIL L DO Q ~ B[I,K] | B[K,J] + Q ; SLVE0640
|
|
B[I,J] ~ (B[I,J]-Q)/DIAG SLVE0650
|
|
END SLVE0660
|
|
END ; SLVE0670
|
|
|
|
COMMENT THE REDUCED "C" VECTOR IS COMPUTED. ; SLVE0680
|
|
|
|
REP: FOR I ~ 1 STEP 1 UNTIL N DO SLVE0690
|
|
BEGIN SLVE0700
|
|
TEMP ~ C[F[I]] ; C[F[I]] ~ C[I] ; D[I] ~ C[I] ~ TEMP SLVE0710
|
|
END ; SLVE0720
|
|
|
|
COMMENT THE BACKWARD PASS, GIVING THE DESIRED SOLUTION, SLVE0730
|
|
IS EXECUTED. ; SLVE0740
|
|
|
|
FOR I ~ 1 STEP 1 UNTIL N DO SLVE0750
|
|
BEGIN SLVE0760
|
|
L ~ I-1 ; Q~0 ; SLVE0770
|
|
S7: FOR K ~ 1 STEP 1 UNTIL L DO Q ~ B[I,K] | D[K] + Q ; SLVE0780
|
|
D[I] ~ (D[I]-Q)/B[I,I] SLVE0790
|
|
END ; SLVE0800
|
|
S8: FOR I ~ N STEP -1 UNTIL 1 DO SLVE0810
|
|
BEGIN SLVE0820
|
|
Q~0 ; SLVE0830
|
|
FOR K ~ I+1 STEP 1 UNTIL N DO Q ~ B[I,K] | X[K] + Q ; SLVE0840
|
|
X[I] ~ D[I] - Q SLVE0850
|
|
END ; SLVE0860
|
|
S9: IF E = 0 THEN GO TO EXIT ; SLVE0870
|
|
|
|
COMMENT THE SOLUTION IS ITERATED AND TESTED FOR ACCURACY. ; SLVE0880
|
|
|
|
J1 ~ 0 ; SLVE0890
|
|
IT1: IF J1 } K1 THEN GO TO E2 ; SLVE0900
|
|
NORM ~ 0 ; SLVE0910
|
|
FOR I ~ 1 STEP 1 UNTIL N DO SLVE0920
|
|
BEGIN SLVE0930
|
|
Q~0 ; L ~ I-1 ; SLVE0940
|
|
S10: FOR K ~ 1 STEP 1 UNTIL N DO Q ~ A[I,K] | X[K] + Q ; SLVE0950
|
|
D[I] ~ C[I] - Q ; SLVE0960
|
|
S11: NORM ~ ABS(D[I]) + NORM ; SLVE0970
|
|
Q~0 ; SLVE0980
|
|
S12: FOR K ~ 1 STEP 1 UNTIL L DO Q ~ B[I,K] | D[K] + Q ; SLVE0990
|
|
D[I] ~ (D[I]-Q)/B[I,I] SLVE1000
|
|
END ; SLVE1010
|
|
FOR I ~ N STEP -1 UNTIL 1 DO SLVE1020
|
|
BEGIN SLVE1030
|
|
Q~0 ; SLVE1040
|
|
S13: FOR K ~ I+1 STEP 1 UNTIL N DO Q ~ B[I,K] | D[K] + Q ; SLVE1050
|
|
X[I] ~ X[I] + D[I] - Q SLVE1060
|
|
END ; SLVE1070
|
|
S14: J1 ~ J1 + 1 ; SLVE1080
|
|
S15: IF N | E < NORM THEN GO TO IT1 ; SLVE1090
|
|
EXIT: END ; SLVE1100
|