github.com/pkimpel.retro-220
1
0
Fork 0
mirror of https://github.com/pkimpel/retro-220.git synced 2026-04-10 22:51:52 +00:00
Code Issues Releases Wiki Activity

Commit initial transcriptions for example BALGOL programs:

Browse Source 
1. Stanford Watershed Model IV.
2. Dirichlet Problem for a bean-shaped region.
This commit is contained in:
Paul Kimpel
2018-02-24 07:10:01 -08:00
parent ed2ada8b85
commit 714993f651
2 changed files with 1693 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

389
software/BALGOL/BALGOL-Examples/DIRICHLET/DIRICHLET.card Normal file
View File

@@ -0,0 +1,389 @@
COMMENT
% DIRICHLET PROBLEM FOR A BEAN-SHAPED REGION. FROM P J DAVIS,
% "ORTHONORMALIZING CODES IN NUMERICAL ANALYSIS" IN J TODD, --SURVEY OF
% NUMERICAL ANLAYSIS--, MCGRAW-HILL, 1962, P.347. P H KIMPEL 8/15/70
% MODIFICATION LOG:
% 92/03/17 P.KIMPEL, PARADIGM CORP, SAN DIEGO, CA 92117.
% CONVERT FOR UNISYS A-SERIES MCP 3.8.4.
% 2014-11-15 P.KIMPEL
% RETRO-CONVERT FROM UNISYS MCP ALGOL BACK TO BURROUGHS B5500 XALGOL.
% 2018-02-20 P.KIMPEL
% RETRO-CONVERT FROM B5500 TO BURROUGHS 220 BALGOL.
;
FORMAT F1 (B30,I3,2X10.3,4X10.5),
F2 (B40,*X*,B9,*Y*,B9,*W*,B8,*BV*,B7,*CBV,*,B7,*DEV*),
FT (W4,B40,*PROCESSOR TIME: *, F6.2,* SEC*);
INTEGER I, J;
REAL SUM, GMDT;
COMMENT ARRAY DIMENSIONS WERE ORIGINALLY DEFINED AS N=43, M=11, P=11..
X, % ABSCISSA VALUES.
Y, % ORDINATE VALUES.
W, % WEIGHTS.
CBV[0:N1], % BOUNDARY VALUES CALCULATED FROM ORTHO COEFS.
BV[0:0, 0:N1+P], % GIVEN BOUNDARY VALUES.
Z[0:M1, 0:N1+P], % APPROXIMATING VECTORS.
ORTHV[0:M, 0:N1+P], % ORTHONORMAL VECTORS RETURNED BY "ORTHO"
DEV[0:0, 0:N1], % DEVIATIONS.
COF[0:0, 0:P1], % COEFFICIENTS.
STD[0:0], % STANDARD DEVIATION.
CV[0:P, 0:P1], % COVARIANCE MATRIX.
VCV[0:0, 0:P, 0:P1], % VARIANCE/COVARIANCE MATRIX.
Q[0:0, 0:M], % FOURIER COEFFICIENTS.
Q2, % SQUARED FOURIER COEFFICIENTS.
E, % SUM OF SQUARED RESIDUALS.
EP[0:0, 0:M1], % RESIDUALS.
A[0:M1, 0:P1], % LOWER TRIANGULAR MATRIX USED TO CALC CV.
GF[0:M], % GRAM FACTORS.
ENF[0:M1]; % NORMS OF THE APPROXIMATING VECTORS.
ARRAY
X(43),
Y(43),
W(43),
CBV(43),
BV(43+11),
Z(11, 43+11),
ORTHV(11, 43+11),
DEV(1, 43),
COF(1, 11),
STD(1),
CV(11+1, 11),
VCV(1, 11+1, 11),
Q(1, 11+1),
Q2(1,11),
E(1,11),
EP(1, 11),
A(11, 11),
GF(11+1),
ENF(11);
PROCEDURE ORTHO (W(), Y(,), Z(,), N, FN, M, P, R, AI, AUI, MUI, ZEI;
X(,), DEV(,), COF(,), STD, CV(,), VCV(,,), GMDT,
Q(,), Q2(,), E(,), EP(,), A(,), GF(), ENF());
BEGIN
REAL FN, GMDT;
INTEGER N, M, P, R, AI, AUI, ZEI, MUI;
COMMENT
ORTHO IS TAKEN FROM ACM ALGORITHM 127 [COMM. ACM, VOL.5,
OCTOBER 1962, P. 511, AUTHOR PHILIP J. WALSH];
INTEGER NPP, NPM, M1, N2, M2, R1, RBAR, P2, BEI, RHI, I18, GAI, SII, I,
J, DEI, NUI, E1Z2, E1Z1, K, THI, ALI, OMI, NII;
ARRAY PK, XP [N+P], QK[M+1];
REAL DENOM, SUM, DK2, DK, FI, SS, SSQ;
NPP = N+P; NPM = N+M; M1 = M-1; N2 = N+1; M2 = M+1;
R1 = 0; RBAR = R; P2 = P+1;
EITHER IF N EQL M; DENOM = 1.0; OTHERWISE; DENOM = SQRT(N-M);
BEI = RHI = I18 = 1;
EITHER IF (P NEQ 0); GAI = SII = 2 OTHERWISE; GAI = SII = 1;
BOX1.. SWITCH AI, (AT1, AT2);
AT1.. FOR J = (1, 1, N); BEGIN
X[2,J] = Z[1,J]; X[1,J] = 1.0 END;
FOR I = (2, 1, M1); BEGIN
FOR J = (1, 1, N);
X[I+1,J] = X[I,J] . X[2,J] END; GO TO BOX2;
AT2.. FOR I = (1, 1, M); BEGIN
FOR J = (1, 1, N);
X[I,J] = Z[I,J] END;
BOX2.. EITHER IF P EQL 0; GO TO BOX3 OTHERWISE; SWITCH AUI, (AU1, AU2);
AU1.. FOR I = (1, 1, M); BEGIN
FOR J = (N2, 1, NPP);
X[I,J] = 0.0; X[I,N+I] = 1.0 END; GO TO BOX3;
AU2.. FOR I = (1, 1, M); BEGIN
FOR J = (N2, 1, NPP);
X[I,J] = Z[I,J] END;
BOX3.. DEI = NUI = E1Z1 = E1Z2 = K = 1;
BOX4.. THI = 1;
BOX5.. ALI = OMI = 1; EITHER IF P EQL 0; GO TO BOX6 OTHERWISE;
FOR J = (1, 1, P); PK[N+J] = 0.0;
BOX6.. GO TO SWITCH MUI, (MU1, MU2);
MU1.. FOR I = (1, 1, N); PK[I] = X[K,I];
GO TO BOX7;
MU2.. FOR I = (1, 1, N);
PK[I] = X[K,I] . W[I]; GO TO BOX7;
BOX7.. SWITCH OMI, (OM1, OM2);
OM1.. FOR I = (1, 1, K); BEGIN SUM = 0.0;
FOR J = (1, 1, NPP);
SUM = SUM + PK[J] . X[I,J]; QK[I] = SUM END;
GO TO BOX8;
OM2.. DK2 = 0.0; FOR I = (1, 1, NPP);
DK2 = DK2 + PK[I] . X[K,I];
DK = SQRT(DK2);
GF[I18] = DK; I18 = I18 + 1;
FOR I = (1, 1, NPP);
X[K,I] = X[K,I]/DK;;
OMI = 1; GO TO BOX6;
BOX8.. SWITCH DEI, (DE1, DE2);
DE1.. E1Z1 = -E1Z1; EITHER IF E1Z1 < 0; GO TO BOX8B OTHERWISE;
GO TO BOX8A;
BOX8A.. FOR I = (1, 1, K-1);
QK[I] = -QK[I]; QK[K] = 1.0;
FOR I = (1, 1, NPP); BEGIN
SUM = 0.0; FOR J = (1, 1, K);
SUM = SUM + X[J,I] . QK[J];
XP[I] = SUM END; GO TO BOX9;
BOX8B.. ENF[I18] = SQRT(QK[K]); GO TO BOX8A;
DE2.. E1Z2 = -E1Z2; EITHER IF E1Z2 < 0; GO TO BOX8C OTHERWISE;
GO TO BOX8A;
BOX8C.. FOR I = (1, 1, M); BEGIN
Q[R1,I] = QK[I]; Q2[R1,I] = QK[I] . QK[I] END;
Q[R1,M2] = QK[M2]; E[R1,1] = Q[R1,M2] - Q2[R1,1];
FOR J = (2, 1, M);
E[R1,J] = E[R1,J-1] - Q2[R1,J];
FI = 1.0;
FOR I = (1, 1, M); BEGIN
EITHER IF (FN - FI) > 0.0; BEGIN EITHER IF E[R1,I] < 0.0;
BEGIN EP[R1,I] = -SQRT(ABS(E[R1,I])/(FN - FI));
GO TO BOX8D; END
OTHERWISE; EP[R1,I] = SQRT(E[R1,I]/(FN - FI));
GO TO BOX8D; END OTHERWISE; E[R1,I] = -1.0;
BOX8D.. FI = FI + 1.0; END; GO TO BOX8A;
BOX9.. SWITCH THI, (TH1, TH2, TH3);
TH1.. FOR I = (1, 1, NPP);
X[K,I] = XP[I]; GO TO BOX10;
TH2.. FOR I = (1, 1, N);
DEV[R1,I] = XP[I];
FOR I = (1, 1, P);
COF[R1,I] = -XP[N+I]; THI = 3; GO TO TH1;
TH3.. GO TO BOX11;
BOX10.. SWITCH ALI, (AL1, AL2);
AL1.. OMI = ALI = 2; GO TO BOX6;
AL2.. EITHER IF K < M; BEGIN K = K + 1; GO TO BOX4; END
OTHERWISE; GO TO BOX12;
BOX11.. SWITCH NUI, (NU1, NU2);
NU1.. NUI = 2; GO TO BOX14;
NU2.. SS = DK/DENOM; SSQ = SS . SS;
STD[R1] = SS; GO TO BOX14;
BOX12.. SWITCH BEI, (BE1, BE2);
BE1.. FOR I = (1, 1, M); BEGIN
FOR J = (1, 1, P);
A[I,J] = X[I,N+J] END;
GMDT = 1.0; FOR I = (1, 1, M);
GMDT = GMDT . (GF[I]/ENF[I]);
GMDT = GMDT . GMDT; DEI = BEI = THI = 2;
K = K + 1; GO TO BOX13;
BE2.. GO TO BOX11;
BOX13.. SWITCH GAI, (GA1, GA2);
GA1.. GO TO BOX11;
GA2.. FOR I = (1, 1, P); BEGIN
FOR J = (I, 1, P); BEGIN
SUM = 0.0;
FOR NII = (1, 1, M);
SUM = SUM + A[NII,I] . A[NII,J];
CV[I,J] = SUM END END;
FOR I = (1, 1, P);
CV[P2,I] = SQRT(CV[I,I]); GAI = 1; GO TO BOX11;
BOX14.. SWITCH RHI, (RH1, RH2);
RH1.. EITHER IF RBAR EQL 0; GO TO FINAL OTHERWISE; RBAR = RBAR - 1;
R1 = R1 + 1; THI = RHI = 2; SWITCH ZEI, (ZE1, ZE2);
ZE1.. FOR I = (1, 1, N);
X[M2,I] = Y[R1,I];
FOR I = (1, 1, P);
X[M2,N+I] = 0.0; GO TO BOX5;
ZE2.. FOR I = (1, 1, NPP);
X[M2,I] = Y[R1,I]; GO TO BOX5;
RH2.. SWITCH SII, (SI1, SI2);
SI1.. GO TO RH1;
SI2.. FOR I = (1, 1, P); BEGIN
FOR J = (I, 1, P);
VCV[R1,I,J] = SSQ . CV[I,J] END;
FOR I = (1, 1, P);
VCV[R1, P2, I] = SS . CV[P2,I]; GO TO RH1;
FINAL.. RETURN END ORTHO ;
PROCEDURE G (I, X, Y); REAL G;
REAL X, Y; INTEGER I;
SWITCH I, (G1, G2, G3, G4, G5, G6, G7, G8, G9, G10,
G11, G12, G13, G14, G15, G16, G17);
G = 0;
RETURN;
G1..
G = 1;
RETURN;
G2..
G = X;
RETURN;
G3..
G = Y;
RETURN;
G4..
G = X*2 - Y*2;
RETURN;
G5..
G = 2.0 . X . Y;
RETURN;
G6..
G = X*3 - 3.0 . X . Y*2;
RETURN;
G7..
G = 3.0 . X*2 . Y - Y*3;
RETURN;
G8..
G = X*4 + Y*4 - 6.0 . X*2 . Y*2;
RETURN;
G9..
G = 4.0 . X*3 . Y - 4.0 . X . Y*3;
RETURN;
G10..
G = X*5 - 10.0 . X*3 . Y*2 + 5.0 . X . Y*4;
RETURN;
G11..
G = Y*5 - 10.0 . Y*3 . X*2 + 5.0 . Y . X*4;
RETURN;
G12..
G = X*6 - 15.0 . X*4 . Y*2 + 15.0 . X*2 . Y*4 - Y*6;
RETURN;
G13..
G = 6.0 . X*5 . Y + 6.0 . X . Y*5 - 20.0 . X*3 . Y*3;
RETURN;
G14..
G = X*7 - 21.0 .X*5 . Y*2 + 35.0 . X*3 . Y*4 - 7.0 . X .
Y*6;
RETURN;
G15..
G = 7.0 . X*6 . Y - 35.0 . X*4 . Y*3 + 21.0 . X*2 . Y*5 -
Y*7;
RETURN;
G16..
G = X*8 + Y*8 - 28.0 . X*6 . Y*2 + 70.0 . X*4 . Y*4 - 28.0
. X*2 . Y*6;
RETURN;
G17..
G = 8.0 . X*7 . Y - 56.0 . X*5 . Y*3 + 56.0 . X*3 . Y*5
- 8.0 . X . Y*7;
RETURN;
END G;
FOR I = (0, 1, N1);
BEGIN
READ (CDS, /, X[I], Y[I], W[I]);
BV[0,I] = EXP(X[I]) . COS(Y[I]) + LOG((1 - Y[I])*2 + X[I]*2);
FOR J = (0, 1, M1);
Z[J,I] = G(J+1, X[I], Y[I]);
END;
CLOSE (CDS);
ORTHO (W, BV, Z, N , N , M , P, 1, 2, 1, 2, 1, ORTHV, DEV, COF, STD,
CV, VCV, GMDT, Q, Q2, E, EP, A, GF, ENF);
FOR I = (0, 1, N1);
BEGIN SUM = 0;
FOR J = (0, 1, M1); SUM = SUM + COF[0,J].G(J+1, X[I], Y[I]
);
CBV[I] = SUM;
END;
WRITE (PR[DBL], F2);
WRITE (PR, F1, FOR I = (0, 1, N1); [I,X[I],Y[I],W[I], BV[0,I],
CBV[I], (CBV[I]-BV[0,I])]);
WRITE (PR, FT, TIME(2)/60);
QUIT..
PROCEDURE DMMP (NAME, ROW, SZ);
VALUE NAME, SZ;
ALPHA NAME, SZ;
ARRAY ROW[0];
BEGIN
REAL
I,
UB;
FORMAT
F (A6," = ",/*(6E20.11,/));
UB = SZ-1;
WRITE (PR[DBL]);
WRITE (PR[DBL]);
WRITE (PR, F, NAME, (SZ+5)DIV 6,
FOR I = (0, 1, UB); ROW[I]);
END DMMP;
ARRAY NR[0:99];
FOR I = (0, 1, 99);
REPLACE POINTER(NR[I])+6 BY I FOR 2 DIGITS;
DMMP ("X ", X, N1+1);
DMMP ("Y ", Y, N1+1);
DMMP ("W ", W, N1+1);
DMMP ("CBV ", CBV, N1+1);
DMMP ("BV ", BV[0,*], N1+P+1);
FOR I = (0, 1, M1);
BEGIN
SUM = "Z " & NR[I] [11:12];
DMMP (SUM, Z[I,*], N1+P+1);
END;
FOR I = (0, 1, M);
BEGIN
SUM = "ORTHV " & NR[I] [11:12];
DMMP (SUM, ORTHV[I,*], N1+P+1);
END;
DMMP ("DEV ", DEV[0,*], N1+1);
DMMP ("COF ", COF[0,*], P1+1);
DMMP ("STD ", STD, 1);
FOR I = (0, 1, P);
BEGIN
SUM = "CV " & NR[I] [11:12];
DMMP (SUM, CV[I,*], P1+1);
END;
FOR I = (0, 1, P);
BEGIN
SUM = "VCV " & NR[I] [11:12];
DMMP (SUM, VCV[0,I,*], P1+1);
END;
DMMP ("EP ", EP[0,*], M1+1);
FOR I = (0, 1, M1);
BEGIN
SUM = "A " & NR[I] [11:12];
DMMP (SUM, A[I,*], P1+1);
END;
DMMP ("GF ", GF, M+1);
DMMP ("Q ", Q[0,*], M+1);
DMMP ("Q2 ", Q2[0,*], M1+1);
DMMP ("E ", E[0,*], M1+1);
DMMP ("ENF ", ENF, M1+1);
FINISH;
5 0.000, 0.110, 0.01414,
5-0.050, 0.108, 0.01427,
5-0.100, 0.115, 0.01963,
5-0.160, 0.150, 0.02300,
5-0.220, 0.205, 0.03897,
5-0.320, 0.300, 0.02792,
5-0.400, 0.358, 0.03324,
5-0.500, 0.420, 0.01483,
5-0.550, 0.436, 0.01423,
5-0.600, 0.430, 0.01505,
5-0.644, 0.400, 0.01483,
5-0.660, 0.350, 0.01420,
5-0.655, 0.300, 0.02881,
5-0.635, 0.200, 0.03043,
5-0.595, 0.100, 0.03076,
5-0.552, 0.000, 0.03311,
5-0.500, -0.105, 0.03175,
5-0.440, -0.200, 0.01809,
5-0.400, -0.250, 0.01998,
5-0.350,-0.300, 0.01882,
5-0.300, -0.344, 0.03140,
5-0.204, -0.400, 0.03450,
5-0.100, -0.436, 0.02846,
5 0.000, -0.448, 0.02831,
5 0.100, -0.442, 0.03860,
5 0.230, -0.400, 0.02431,
5 0.300, -0.350, 0.02059,
5 0.353, -0.300, 0.03566,
5 0.430, -0.200, 0.03122,
5 0.477, -0.100, 0.02975,
5 0.510, 0.000, 0.02846,
5 0.522, 0.100, 0.01696,
5 0.520, 0.160, 0.02330,
5 0.500, 0.240, 0.02102,
5 0.456, 0.300, 0.01795,
5 0.400, 0.330, 0.01147,
5 0.360, 0.337, 0.01762,
5 0.300, 0.320, 0.01648,
5 0.250, 0.290, 0.01901,
5 0.300, 0.245, 0.01901,
5 0.150, 0.200, 0.01809,
5 0.100, 0.160, 0.01677,
5 0.050, 0.128, 0.01501,
5 SENTINEL

1304
software/StanfordModelIV/StanfordModelIV.card Normal file
View File

File diff suppressed because it is too large Load Diff