github.com/pkimpel.retro-b5500
1
0
Fork 0
mirror of https://github.com/pkimpel/retro-b5500.git synced 2026-02-13 19:54:50 +00:00
Code Releases Activity
Files
127edd65d528a268f00a5f89ced7986ffc90faab
pkimpel.retro-b5500/tests/ALGOLXEM/ORTHO.alg_m
paul.kimpel@digm.com e128c9fa8a 1. Commit updated ALGOLXEM compiler source and additional test cases from recent debugging effort. 
2. Rename original NEATUP source from UTIL.NEATUP.alg_m to NEATUP.alg_m.
2012-05-06 16:38:23 +00:00

191 lines
17 KiB
Plaintext
Raw Blame History

$ SET LIST $ PRT DEBUGN 00000010120430PK
% -ORTHO- TEST, 3/3/70 00000100120429PK
BEGIN 00000200
INTEGER STARTT; 00000300120429PK
FORMAT FT (//"DATE: "A6" PROC TIME: "F8.2" I/O TIME: "F8.2" ELAPSED: " 00000400120429PK
F8.2" SEC"); 00000500120429PK
INTEGER I, J, N, M, P, R, AI, AUI, ZEI, MUI; 00000600120429PK
REAL SUM, GMDT, FN; 00000700120429PK
FILE IN PARAMS (1,10); 00000800120429PK
FILE OUT FLUSH 18 (5,17); 00000900120429PK
00001000120429PK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00002000120429PK
PROCEDURE ORTHO (W, Y, Z, N, FN, M, P, R, AI, AUI, MUI, ZEI, X, DEV, 00003000
COF, STD, CV, VCV, GMDT, Q, Q2, E, EP, A, GF, ENF); 00004000
VALUE N, M, P, R, AI, AUI, MUI, ZEI; 00005000
REAL FN, GMDT; 00006000
REAL ARRAY STD, GF, W, ENF [1]; 00007000
REAL ARRAY Y, Z, X, DEV, COF, CV, Q, Q2, E, EP, A [1, 1]; 00008000
REAL ARRAY VCV [1, 1, 1]; 00009000
INTEGER N, M, P, R, AI, AUI, ZEI, MUI; 00010000
00011000120429PK
COMMENT 00012000
ORTHO IS TAKEN FROM ACM ALGORITHM 127 [COMM. ACM, VOL.5, 00013000
OCTOBER 1962, P. 511, AUTHOR: PHILIP J. WALSH]; 00014000
00015000120429PK
BEGIN 00016000
INTEGER NPP, NPM, M1, N2, M2, R1, RBAR, P2, BEI, RHI, I18, GAI, SII, I,00017000
J, DEI, NUI, E1Z2, E1Z1, K, THI, ALI, OMI, NII; 00018000
REAL ARRAY PK, XP [1:N+P], QK[1:M+1]; 00019000
REAL DENOM, SUM, DK2, DK, FI, SS, SSQ; 00020000
LABEL BOX1, AT1, AT2, BOX2, AU1, AU2, BOX3, BOX4, BOX5, BOX6, MU1, 00021000
MU2, BOX7, OM1, OM2, BOX8, DE1, BOX8A, BOX8B, DE2, BOX8C, BOX8D, 00022000
BOX9, TH1, TH2, TH3, BOX10, AL1, AL2, BOX11, NU1, NU2, BOX12, 00023000
BE1, BE2, BOX13, GA1, GA2, BOX14, RH1, ZE1, ZE2, RH2, SI1, SI2, 00024000
FINAL; 00025000
SWITCH AT ~ AT1, AT2; SWITCH ZE ~ ZE1, ZE2; 00026000120429PK
SWITCH AU ~ AU1, AU2; SWITCH MU ~ MU1, MU2; 00027000120429PK
SWITCH BE ~ BE1, BE2; SWITCH RH ~ RH1, RH2; SWITCH GA ~ GA1, GA2; 00028000120429PK
SWITCH SI ~ SI1, SI2; SWITCH DE ~ DE1, DE2; SWITCH NU ~ NU1, NU2; 00029000120429PK
SWITCH TH ~ TH1, TH2, TH3; SWITCH AL ~ AL1, AL2; 00030000120429PK
SWITCH OM ~ OM1, OM2; 00031000120429PK
NPP ~ N+P; NPM ~ N+M; M1 ~ M-1; N2 ~ N+1; M2 ~ M+1; 00032000120429PK
R1 ~ 0; RBAR ~ R; P2 ~ P+1; DENOM ~ IF N=M THEN 1.0 00033000120429PK
ELSE SQRT(N-M); BEI ~ RHI ~ I18 ~ 1; 00034000120429PK
IF (P ! 0) THEN GAI ~ SII ~ 2 ELSE GAI ~ SII ~ 1; 00035000120501PK
BOX1: GO TO AT[AI]; 00036000
AT1: FOR J ~ 1 STEP 1 UNTIL N DO BEGIN 00037000120429PK
X[2,J] ~ Z[1,J]; X[1,J] ~ 1.0 END; 00038000120429PK
FOR I ~ 2 STEP 1 UNTIL M1 DO BEGIN 00039000120429PK
FOR J ~ 1 STEP 1 UNTIL N DO 00040000120429PK
X[I+1,J] ~ X[I,J] | X[2,J] END; GO TO BOX2; 00041000120429PK
AT2: FOR I ~ 1 STEP 1 UNTIL M DO BEGIN 00042000120429PK
FOR J ~ 1 STEP 1 UNTIL N DO 00043000120429PK
X[I,J] ~ Z[I,J] END; 00044000120429PK
BOX2: IF P = 0 THEN GO TO BOX3 ELSE GO TO AU[AUI]; 00045000
AU1: FOR I ~ 1 STEP 1 UNTIL M DO BEGIN 00046000120429PK
FOR J ~ N2 STEP 1 UNTIL NPP DO 00047000120429PK
X[I,J] ~ 0.0; X[I,N+I] ~ 1.0 END; GO TO BOX3; 00048000120429PK
AU2: FOR I ~ 1 STEP 1 UNTIL M DO BEGIN 00049000120429PK
FOR J ~ N2 STEP 1 UNTIL NPP DO 00050000120429PK
X[I,J] ~ Z[I,J] END; 00051000120429PK
BOX3: DEI ~ NUI ~ E1Z1 ~ E1Z2 ~ K ~ 1; 00052000120429PK
BOX4: THI ~ 1; 00053000120429PK
BOX5: ALI ~ OMI ~ 1; IF P = 0 THEN GO TO BOX6 ELSE 00054000120429PK
FOR J ~ 1 STEP 1 UNTIL P DO PK[N+J] ~ 0.0; 00055000120429PK
BOX6: GO TO MU[MUI]; 00056000
MU1: FOR I ~ 1 STEP 1 UNTIL N DO PK[I] ~ X[K,I]; 00057000120429PK
GO TO BOX7; 00058000
MU2: FOR I ~ 1 STEP 1 UNTIL N DO 00059000120429PK
PK[I] ~ X[K,I] | W[I]; GO TO BOX7; 00060000120429PK
BOX7: GO TO OM[OMI]; 00061000
OM1: FOR I ~ 1 STEP 1 UNTIL K DO BEGIN SUM ~ 0.0; 00062000120429PK
FOR J ~ 1 STEP 1 UNTIL NPP DO 00063000120429PK
SUM ~ SUM + PK[J] | X[I,J]; QK[I] ~ SUM END; 00064000120429PK
GO TO BOX8; 00065000
OM2: DK2 ~ 0.0; FOR I ~ 1 STEP 1 UNTIL NPP DO 00066000120429PK
DK2 ~ DK2 + PK[I] | X[K,I]; 00067000120429PK
DK ~ SQRT(DK2); 00068000120429PK
GF[I18] ~ DK; I18 ~ I18 + 1; 00069000120429PK
FOR I ~ 1 STEP 1 UNTIL NPP DO 00070000120429PK
X[K,I] ~ X[K,I]/DK;; 00071000120429PK
OMI ~ 1; GO TO BOX6; 00072000120429PK
BOX8: GO TO DE[DEI]; 00073000
DE1: E1Z1 ~ -E1Z1; IF E1Z1 < 0 THEN GO TO BOX8B ELSE 00074000120429PK
GO TO BOX8A; 00075000
BOX8A: FOR I ~ 1 STEP 1 UNTIL K-1 DO 00076000120429PK
QK[I] ~ -QK[I]; QK[K] ~ 1.0; 00077000120429PK
FOR I ~ 1 STEP 1 UNTIL NPP DO BEGIN 00078000120429PK
SUM ~ 0.0; FOR J ~ 1 STEP 1 UNTIL K DO 00079000120429PK
SUM ~ SUM + X[J,I] | QK[J]; 00080000120429PK
XP[I] ~ SUM END; GO TO BOX9; 00081000120429PK
BOX8B: ENF[I18] ~ SQRT(QK[K]); GO TO BOX8A; 00082000120429PK
DE2: E1Z2 ~ -E1Z2; IF E1Z2 < 0 THEN GO TO BOX8C ELSE 00083000120429PK
GO TO BOX8A; 00084000
BOX8C: FOR I ~ 1 STEP 1 UNTIL M DO BEGIN 00085000120429PK
Q[R1,I] ~ QK[I]; Q2[R1,I] ~ QK[I] | QK[I] END; 00086000120429PK
Q[R1,M2] ~ QK[M2]; E[R1,1] ~ Q[R1,M2] - Q2[R1,1]; 00087000120429PK
FOR J ~ 2 STEP 1 UNTIL M DO 00088000120429PK
E[R1,J] ~ E[R1,J-1] - Q2[R1,J]; 00089000120429PK
FI ~ 1.0; 00090000120429PK
FOR I ~ 1 STEP 1 UNTIL M DO BEGIN 00091000120429PK
IF (FN - FI) > 0.0 THEN BEGIN IF E[R1,I] < 0.0 THEN 00093000
BEGIN EP[R1,I] ~ -SQRT(ABS(E[R1,I])/(FN - FI)); 00094000120429PK
GO TO BOX8D; END 00095000
ELSE EP[R1,I] ~ SQRT(E[R1,I]/(FN - FI)); 00096000120429PK
GO TO BOX8D; END ELSE E[R1,I] ~ -1.0; 00097000120429PK
BOX8D: FI ~ FI + 1.0; END; GO TO BOX8A; 00098000120429PK
BOX9: GO TO TH[THI]; 00099000
TH1: FOR I ~ 1 STEP 1 UNTIL NPP DO 00100000120429PK
X[K,I] ~ XP[I]; GO TO BOX10; 00101000120429PK
TH2: FOR I ~ 1 STEP 1 UNTIL N DO 00102000120429PK
DEV[R1,I] ~ XP[I]; 00103000120429PK
FOR I ~ 1 STEP 1 UNTIL P DO 00104000120429PK
COF[R1,I] ~ -XP[N+I]; THI ~ 3; GO TO TH1; 00105000120429PK
TH3: GO TO BOX11; 00106000
BOX10: GO TO AL[ALI]; 00107000
AL1: OMI ~ ALI ~ 2; GO TO BOX6; 00108000120429PK
AL2: IF K < M THEN BEGIN K ~ K + 1; GO TO BOX4; END 00109000120429PK
ELSE GO TO BOX12; 00110000
BOX11: GO TO NU[NUI]; 00111000
NU1: NUI ~ 2; GO TO BOX14; 00112000120429PK
NU2: SS ~ DK/DENOM; SSQ ~ SS | SS; 00113000120429PK
STD[R1] ~ SS; GO TO BOX14; 00114000120429PK
BOX12: GO TO BE[BEI]; 00115000
BE1: FOR I ~ 1 STEP 1 UNTIL M DO BEGIN 00116000120429PK
FOR J ~ 1 STEP 1 UNTIL P DO 00117000120429PK
A[I,J] ~ X[I,N+J] END; 00118000120429PK
GMDT ~ 1.0; FOR I ~ 1 STEP 1 UNTIL M DO 00119000120429PK
GMDT ~ GMDT | (GF[I]/ENF[I]); 00120000120429PK
GMDT ~ GMDT | GMDT; DEI ~ BEI ~ THI ~ 2; 00121000120429PK
K ~ K + 1; GO TO BOX13; 00122000120429PK
BE2: GO TO BOX11; 00123000
BOX13: GO TO GA[GAI]; 00124000
GA1: GO TO BOX11; 00125000
GA2: FOR I ~ 1 STEP 1 UNTIL P DO BEGIN 00126000120429PK
FOR J ~ I STEP 1 UNTIL P DO BEGIN 00127000120429PK
SUM ~ 0.0; 00128000120429PK
FOR NII ~ 1 STEP 1 UNTIL M DO 00129000120429PK
SUM ~ SUM + A[NII,I] | A[NII,J]; 00130000120429PK
CV[I,J] ~ SUM END END; 00131000120429PK
FOR I ~ 1 STEP 1 UNTIL P DO 00132000120429PK
CV[P2,I] ~ SQRT(CV[I,I]); GAI ~ 1; GO TO BOX11; 00133000120429PK
BOX14: GO TO RH[RHI]; 00134000
RH1: IF RBAR = 0 THEN GO TO FINAL ELSE RBAR ~ RBAR - 1; 00135000120429PK
R1 ~ R1 + 1; THI ~ RHI ~ 2; GO TO ZE[ZEI]; 00136000120429PK
ZE1: FOR I ~ 1 STEP 1 UNTIL N DO 00137000120429PK
X[M2,I] ~ Y[R1,I]; 00138000120429PK
FOR I ~ 1 STEP 1 UNTIL P DO 00139000120429PK
X[M2,N+I] ~ 0.0; GO TO BOX5; 00140000120429PK
ZE2: FOR I ~ 1 STEP 1 UNTIL NPP DO 00141000120429PK
X[M2,I] ~ Y[R1,I]; GO TO BOX5; 00142000120429PK
RH2: GO TO SI[SII]; 00143000
SI1: GO TO RH1; 00144000
SI2: FOR I ~ 1 STEP 1 UNTIL P DO BEGIN 00145000120429PK
FOR J ~ I STEP 1 UNTIL P DO 00146000120429PK
VCV[R1,I,J] ~ SSQ | CV[I,J] END; 00147000120429PK
FOR I ~ 1 STEP 1 UNTIL P DO 00148000120429PK
VCV[R1, P2, I] ~ SS | CV[P2,I]; GO TO RH1; 00149000120429PK
FINAL: END ORTHO ; 00150000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00151000120429PK
00152000120429PK
STARTT ~ TIME(1); 00901000120429PK
READ (PARAMS, /, N, M, P); 00902000120429PK
CLOSE(PARAMS); 00903000120429PK
R ~ 1; AI ~ 2; AUI ~ 1; 00904000120429PK
ZEI ~ 1; MUI ~ 2; FN ~ N; 00905000120430PK
00906000120429PK
BEGIN %INNER BLOCK 00907000120429PK
LABEL DUMPIT; 00908000120429PK
REAL ARRAY W[1:N], Y[1:R, 1:N+P], Z[1:M, 1:N+P], 00909000120429PK
X[1:M+1, 1:N+P], DEV[1:R, 1:N], COF[1:R, 1:P], STD[1:R], 00910000120429PK
CV[1:P+1, 1:P], VCV[1:R, 1:P+1, 1:P], Q[1:R, 1:M+1], 00911000120429PK
Q2, E, EP [1:R, 1:M], A[1:M, 1:P], GF[1:M+R], ENF[1:M]; 00912000120429PK
DUMP FLUSH (N, M, P, R, AI, AUI, ZEI, MUI, 00913000120429PK
GMDT, FN, 00914000120429PK
W, Y, Z, X, DEV, COF, STD, CV, VCV, Q, Q2, A, GF, ENF, E, 00915000120429PK
EP) DUMPIT:1; 00916000120429PK
FOR I ~ 1 STEP 1 UNTIL N DO 00917000120429PK
BEGIN 00918000120429PK
W[I] ~ 1.0; SUM ~ 0.0; 00919000120429PK
FOR J ~ 1 STEP 1 UNTIL M DO 00920000120429PK
SUM ~ SUM + J|(Z[J,I] ~ I*J); 00921000120429PK
Y[1,I] ~ SUM; 00922000120429PK
END; 00922500120430PK
ORTHO (W, Y, Z, N, FN, M, P, R, AI, AUI, MUI, ZEI, X, DEV, 00923000120429PK
COF, STD, CV, VCV, GMDT, Q, Q2, E, EP, A, GF, ENF); 00924000120429PK
00924500120430PK
DUMPIT: END INNER BLOCK; 00925000120429PK
WRITE(FLUSH, FT, TIME(0), TIME(2)/60, TIME(3)/60, (TIME(1)-STARTT)/60); 00926000120429PK
END. 00999000
View Git Blame Copy Permalink