retro-software.B5500-software/CUBE-Library-13/Files/POLYCF1-E200001.alg

COMMENT        PROCEDURE - POLYNOMIAL CURVE FIT,                        00000100
               CUBE LIBRARY NUMBER IS E200001.                          00000200
               THIS VERSION DATED 2/1/67;                               00000300
PROCEDURE LSQ(D,NP,XA,YA,ANS,ET);VALUE D,NP;INTEGER D,NP;REAL ARRAY XA,Y00000400
A,ANS[1];LABEL ET;BEGIN REAL ARRAY A[1:D+1,1:D+1],C[1:D+1];LABEL L1,DONE00000500
,E1;INTEGER I,J,DC;PROCEDURE SOLVE(N,A,C,RSW,E,K1,EPS,X,E1,E2);VALUE N,R00000600
SW,E,K1,EPS ;INTEGER N,K1 ;REAL E,EPS ;BOOLEAN RSW ;REAL ARRAY A[1,1],C,00000700
X[1];LABEL E1,E2 ;BEGIN INTEGER I,J,K,J1,K2,L ;REAL BIG,TEMP,DIAG,NORM,Q00000800
 ;INTEGER ARRAY F[0:N];REAL ARRAY D[0:N];REAL ARRAY B[0:N,0:N];LABEL S1,00000900
S2,S3,S4,S5,S6,REP,S7,S8,S9,IT1,S10,S11,S12,S13,S14,S15,EXIT ;S1:IF RSW 00001000
THEN GO TO REP ;COMMENT THE COEFFICIENT MATRIX IS TRIANGULARIZED.;FOR I 00001100
:=1 STEP 1 UNTIL N DO FOR J :=1 STEP 1 UNTIL N DO B[I,J]:=A[I,J];S2:FOR 00001200
I :=1 STEP 1 UNTIL N DO BEGIN L :=I-1 ;FOR J :=I STEP 1 UNTIL N DO BEGIN00001300
 Q:=0 ;FOR K :=1 STEP 1 UNTIL L DO Q :=B[J,K]|B[K,I]+Q ;B[J,I]:=B[J,I]-Q00001400
 END ;BIG :=0 ;K2 :=I ;S3:FOR K :=I STEP 1 UNTIL N DO BEGIN IF ABS(B[K,I00001500
])>BIG THEN BEGIN BIG :=ABS(B[K,I]);K2 :=K END END ;COMMENT E1 IS THE NO00001600
N-LOCAL LABEL TO WHICH AN EXIT IS MADE IF THE COEFFICIENT MATRIX IS SING00001700
ULAR.;S4:IF BIG {EPS THEN GO TO E1 ;F[I]:=K2 ;IF K2 !I THEN S5:FOR K :=100001800
 STEP 1 UNTIL N DO BEGIN TEMP :=A[K2,K];A[K2,K]:=A[I,K];A[I,K]:=TEMP ;TE00001900
MP :=B[K2,K];B[K2,K]:=B[I,K];B[I,K]:=TEMP ;END ;DIAG :=B[I,I];S6:FOR J :00002000
=I+1 STEP 1 UNTIL N DO BEGIN Q:=0 ;FOR K :=1 STEP 1 UNTIL L DO Q :=B[I,K00002100
]|B[K,J]+Q ;B[I,J]:=(B[I,J]-Q)/DIAG END END ;COMMENT THE REDUCED "C"VECT00002200
OR IS COMPUTED.;REP:FOR I :=1 STEP 1 UNTIL N DO BEGIN TEMP :=C[F[I]];C[F00002300
[I]]:=C[I];D[I]:=C[I]:=TEMP END ;COMMENT THE BACKWARD PASS,GIVING THE DE00002400
SIRED SOLUTION,IS EXECUTED.;FOR I :=1 STEP 1 UNTIL N DO BEGIN L :=I-1 ;Q00002500
:=0 ;S7:FOR K :=1 STEP 1 UNTIL L DO Q :=B[I,K]|D[K]+Q ;D[I]:=(D[I]-Q)/B[00002600
I,I]END ;S8:FOR I :=N STEP -1 UNTIL 1 DO BEGIN Q:=0 ;FOR K :=I+1 STEP 1 00002700
UNTIL N DO Q :=B[I,K]|X[K]+Q ;X[I]:=D[I]-Q END ;S9:IF E =0 THEN GO TO EX00002800
IT ;COMMENT THE SOLUTION IS ITERATED AND TESTED FOR ACCURACY,;J1:=0 ;IT100002900
:IF J1 }K1 THEN GO TO E2 ;NORM :=0 ;FOR I :=1 STEP 1 UNTIL N DO BEGIN Q:00003000
=0 ;L :=I-1 ;S10:FOR K :=1 STEP 1 UNTIL N DO Q :=A[I,K]|X[K]+Q ;D[I]:=C[00003100
I]-Q ;S11:NORM :=ABS(D[I])+NORM ;Q:=0 ;S12:FOR K :=1 STEP 1 UNTIL L DO Q00003200
 :=B[I,K]|D[K]+Q ;D[I]:=(D[I]-Q)/B[I,I]END ;FOR I :=N STEP -1 UNTIL 1 DO00003300
 BEGIN Q:=0 ;S13:FOR K :=I+1 STEP 1 UNTIL N DO Q :=B[I,K]|D[K]+Q ;X[I]:=00003400
X[I]+D[I]-Q END ;S14:J1 :=J1 +1 ;S15:IF N |E <NORM THEN GO TO IT1 ;EXIT:00003500
END ;IF D{0 OR D>10 THEN BEGIN ANS[1]:=1;GO TO ET END;DC:=0;FOR I:=1 STE00003600
P 1 UNTIL D+1 DO BEGIN FOR J:=1 STEP 1 UNTIL D+1 DO A[I,J]:=C[I]:=0 END;00003700
COMMENT BEGIN FIRST DEGREE;A[1,1]:=NP;FOR I:=1 STEP 1 UNTIL NP DO BEGIN 00003800
A[1,2]:=A[1,2]+XA[I];A[2,2]:=XA[I]*2+A[2,2];C[1]:=C[1]+YA[I];C[2]:=YA[I]00003900
|XA[I]+C[2]END;A[2,1]:=A[1,2];DC:=DC+1;IF DC=D THEN GO TO L1;COMMENT DEG00004000
REE 2;FOR I:=1 STEP 1UNTIL NP DO BEGIN A[2,3]:=A[2,3]+XA[I]*3;A[3,3]:=XA00004100
[I]*4+A[3,3];C[3]:=XA[I]*2|YA[I]+C[3]END;A[1,3]:=A[3,1]:=A[2,2];A[3,2]:=00004200
A[2,3];DC:=DC+1;IF DC=D THEN GO TO L1 ;COMMENT BEGIN DEGREE 3;FOR I:=1 S00004300
TEP 1 UNTIL NP DO BEGIN A[3,4]:=XA[I]*5+A[3,4];A[4,4]:=XA[I]*6+A[4,4];C[00004400
4]:=XA[I]*3|YA[I]+C[4]END;A[4,1]:=A[1,4]:=A[3,2];A[4,2]:=A[2,4]:=A[3,3];00004500
A[4,3]:=A[3,4];DC:=DC+1;IF DC=D THEN GO TO L1;COMMENT DEGREE 4;FOR I:=1 00004600
STEP 1 UNTIL NP DO BEGIN A[4,5]:=XA[I]*7+A[4,5];A[5,5]:=XA[I]*8+A[5,5];C00004700
[5]:=XA[I]*4|YA[I]+C[5]END;A[5,2]:=A[2,5]:=A[4,3];A[5,3]:=A[3,5]:=A[4,4]00004800
;A[5,4]:=A[4,5];A[5,1]:=A[1,5]:=A[4,2];DC:=DC+1;IF DC=D THEN GO TO L1;CO00004900
MMENT DEGREE 5;FOR I:=1 STEP 1 UNTIL NP DO BEGIN A[5,6]:=XA[I]*9+A[5,6];00005000
A[6,6]:=XA[I]*10+A[6,6];C[6]:=XA[I]*5|YA[I]+C[6]END;A[6,1]:=A[1,6]:=A[5,00005100
2];A[6,2]:=A[2,6]:=A[5,3];A[6,3]:=A[3,6]:=A[5,4];A[6,4]:=A[4,6]:=A[5,5];00005200
A[6,5]:=A[5,6];DC:=DC+1;IF DC=D THEN GO TO L1;COMMENT DEGREE 6;FOR I:=1 00005300
STEP 1 UNTIL NP DO BEGIN A[6,7]:=XA[I]*11+A[6,7];A[7,7]:=XA[I]*12+A[7,7]00005400
;C[7]:=XA[I]*6|YA[I]+C[7]END;A[7,1]:=A[1,7]:=A[6,2];A[7,2]:=A[2,7]:=A[6,00005500
3];A[7,3]:=A[3,7]:=A[6,4];A[7,4]:=A[4,7]:=A[6,5];A[7,5]:=A[5,7]:=A[6,6];00005600
A[7,6]:=A[6,7];DC:=DC+1;IF DC=D THEN GO TO L1;COMMENT DEGREE 7;FOR I:=1 00005700
STEP 1 UNTIL NP DO BEGIN A[7,8]:=XA[I]*13+A[7,8];A[8,8]:=XA[I]*14+A[8,8]00005800
;C[8]:=XA[I]*7|YA[I]+C[8]END;A[8,1]:=A[1,8]:=A[7,2];A[8,2]:=A[2,8]:=A[7,00005900
3];A[8,3]:=A[3,8]:=A[7,4];A[8,4]:=A[4,8]:=A[7,5];A[8,5]:=A[5,8]:=A[7,6];00006000
A[8,6]:=A[6,8]:=A[7,7];A[8,7]:=A[7,8];DC:=DC+1;IF DC=D THEN GO TO L1;COM00006100
MENT DEGREE 8;FOR I:=1 STEP 1 UNTIL NP DO BEGIN A[8,9]:=XA[I]*15+A[8,9];00006200
A[9,9]:=XA[I]*16+A[9,9];C[9]:=XA[I]*8|YA[I]+C[9]END;A[9,1]:=A[1,9]:=A[8,00006300
2];A[9,2]:=A[2,9]:=A[8,3];A[9,3]:=A[3,9]:=A[8,4];A[9,4]:=A[4,9]:=A[8,5];00006400
A[9,5]:=A[5,9]:=A[8,6];A[9,6]:=A[6,9]:=A[8,7];A[9,7]:=A[7,9]:=A[8,8];A[900006500
,8]:=A[8,9];DC:=DC+1;IF DC=D THEN GO TO L1;COMMENT DEGREE 9;FOR I:=1 STE00006600
P 1 UNTIL NP DO BEGIN A[9,10]:=XA[I]*17+A[9,10];A[10,10]:=XA[I]*18+A[10,00006700
10];C[10]:=XA[I]*9|YA[I]+C[10]END;A[10,1]:=A[1,10]:=A[9,2];A[10,2]:=A[2,00006800
10]:=A[9,3];A[10,3]:=A[3,10]:=A[9,4];A[10,4]:=A[4,10]:=A[9,5];A[10,5]:=A00006900
[5,10]:=A[9,6];A[10,6]:=A[6,10]:=A[9,7];A[10,7]:=A[7,10]:=A[9,8];A[10,8]00007000
:=A[8,10]:=A[9,9];A[10,9]:=A[9,10];DC:=DC+1;IF DC=D THEN GO TO L1;COMMEN00007100
T DEGREE 10;FOR I:=1 STEP 1 UNTIL NP DO BEGIN A[10,11]:=XA[I]*19+A[10,1100007200
];A[11,11]:=XA[I]*20+A[11,11];C[11]:=XA[I]*10|YA[I]+C[11]END;A[11,1]:=A[00007300
1,11]:=A[10,2];A[11,2]:=A[2,11]:=A[10,3];A[11,3]:=A[3,11]:=A[10,4];A[11,00007400
4]:=A[4,11]:=A[10,5];A[11,5]:=A[5,11]:=A[10,6];A[11,6]:=A[6,11]:=A[10,7]00007500
;A[11,7]:=A[7,11]:=A[10,8];A[11,8]:=A[8 ,11]:=A[10,9];A[11,9]:=A[9,11]:=00007600
A[10,10];A[11,10]:=A[10,11];L1:SOLVE(D+1,A,C,FALSE,0,0,(D+1)|(0.5@-10),A00007700
NS,E1,DONE);GO TO DONE;COMMENT SINGULAR MATRIX;E1:ANS[1]:=0;GO TO ET;   00007800
DONE:END;                                                               00007900