mirror of
https://github.com/pkimpel/retro-220.git
synced 2026-03-09 04:00:24 +00:00
211 lines
19 KiB
Plaintext
211 lines
19 KiB
Plaintext
$ SET LINEINFO 00000100180203PK
|
|
BEGIN 00001000
|
|
COMMENT 00001100
|
|
BAC-EXAMPLE-1 CONVERTED FROM BALGOL TO BURROUGHS B5500 EXTENDED ALGOL,00001200180203PK
|
|
THEN TO UNISYS MCP EXTENDED ALGOL. 00001220180203PK
|
|
2017-02-13 P.KIMPEL 00001300
|
|
; 00001400
|
|
00010000
|
|
FILE INPUT (KIND=READER, MAXRECSIZE=80, FRAMESIZE=8); 00010100170222PK
|
|
FILE OUTPUT (KIND=PRINTER, MAXRECSIZE=120, FRAMESIZE=8); 00010200170222PK
|
|
00011000170222PK
|
|
DEFINE 00011100170222PK
|
|
DEGREE1 = 0.017453293 #, % PI/180 = 1 DEGREE 00011200170222PK
|
|
DEGREE2 = 0.034906585 #, % PI/90 = 2 DEGREES 00011300170222PK
|
|
DEGREE5 = 0.087266463 #, % PI/36 = 5 DEGREES 00011400170222PK
|
|
DEGREE34 = 0.59341195 #, % 34PI/180 = 34 DEGREES 00011500170222PK
|
|
DEGREE45 = 0.78539816 #; % PI/4 = 45 DEGREES 00011600170222PK
|
|
00020000
|
|
REAL 00050000
|
|
AVT, 00050100
|
|
CONST, 00050200
|
|
SUM; 00050300
|
|
LABEL 00080000
|
|
FINISH, 00080100
|
|
RDIM, 00080200
|
|
START; 00080300
|
|
00200000
|
|
COMMENT FIRST EXAMPLE PROGRAM FROM BALGOL MANUAL, MARCH 1963. 00200100170222PK
|
|
J.G. HERRIOT, OF STANFORD UNIVERSITY, HAS WRITTEN THE FOLLOWING 00200200
|
|
PROGRAM TO DETERMINE AN APROXIMATION OF HARMONIC-BOUNDARY VALUES, 00200300
|
|
USING ORTHONORMAL FUNCTIONS; 00200400
|
|
00200500
|
|
COMMENT THIS PROGRAM FIRST CONSTRUCTS A SET OF ORTHONORMAL FUNCTIONS 00200600
|
|
AND THEN USES THEM TO FIND AN APPROXIMATION TO THE SOLUTION OF A 00200700
|
|
HARMONIC BOUNDARY-VALUE PROBLEM; 00200800
|
|
00200900
|
|
COMMENT WE FIRST CONSTRUCT THE ORTHONORMAL FUNCTIONS; 00201000
|
|
00201100
|
|
INTEGER I, J, K, L, M, N, NU, TH; 00201200
|
|
ARRAY R[1:29], HFN[1:29], DSUM[1:24], HFCN[1:5], HFCEN[1:6], 00201300
|
|
FA[1:25,1:25], A[1:25,1:25], B[1:25,1:25], HA[1:47], HAA[1:24]; 00201400
|
|
LIST DATA (FOR I:=1 STEP 1 UNTIL 29 DO R[I]), DIMEN(N); 00201500170222PK
|
|
LIST FRESULTS (FOR I:=1 STEP 1 UNTIL N DO 00201600170222PK
|
|
FOR J:=1 STEP 1 UNTIL N DO FA[I,J]), 00201700170222PK
|
|
ARESULTS (FOR I:=1 STEP 1 UNTIL N DO 00201800170222PK
|
|
FOR J:=1 STEP 1 UNTIL N DO A[I,J]), 00201900170222PK
|
|
BRESULTS (FOR I:=1 STEP 1 UNTIL N DO 00202000170222PK
|
|
FOR J:=1 STEP 1 UNTIL N DO B[I,J]), 00202100170222PK
|
|
COEFFS (FOR NU:=4 STEP 4 UNTIL N-1 DO HA[2*NU-1]), 00202200170222PK
|
|
HFNRES (FOR K:=1 STEP 1 UNTIL 29 DO HFN[K]), 00202300170222PK
|
|
CRES(CONST), HFCNRES (TH, FOR K:=1 STEP 1 UNTIL 5 DO HFCN[K]), 00202400170222PK
|
|
HFCENRES(TH, FOR K:=1 STEP 1 UNTIL 6 DO HFCEN[K]); 00202500170222PK
|
|
FORMAT VECTOR (X8,6E16.7), 00202600180203PK
|
|
FTITLE (/,X48,"FRESULTS,FA[I,J]"), 00202700
|
|
BTITLE (/,X48,"BRESULTS,B[I,J]"), 00202800170222PK
|
|
ATITLE (/,X48,"ARESULTS,A[I,J]"), 00202900
|
|
COEFTITLE (/,X30,"HA[8NU-1]"), 00203000
|
|
BDYVALUES (/,X42,"PRELIMINARY BOUNDARY VALUES"), 00203100
|
|
CBDYVALUES (/,X43,"CORRECTED BOUNDARY VALUES"), 00203200
|
|
CONTITLE (/,X50,"CONSTANT"), 00203300
|
|
TABLE (X8,I2,X6,6E16.7), 00203400180203PK
|
|
TABLEHEAD (/,X40, "THE VALUES OF H(RHO,TH) IN B"), 00203500
|
|
TABLELINE (X13,"RHO",X6,"0.5",X13,"1.0",X13,"1.5",X13, 00203600
|
|
"2.0",X13,"2.5",X13,"3.0"), 00203700
|
|
TABLETH (X8,"TH"); 00203800
|
|
START: 00800100
|
|
READ (INPUT, /, DATA); 00800200
|
|
WRITE (OUTPUT, <"INPUT DATA:",/,6(5E16.7,/)>, DATA); 00800250180203PK
|
|
RDIM: 00800300
|
|
READ (INPUT, /, DIMEN) [FINISH]; 00800400
|
|
WRITE (OUTPUT, <"NUMBER OF DIMENSIONS:",I3>, DIMEN); 00800450
|
|
FOR I:=1 STEP 1 UNTIL N DO 00800500170222PK
|
|
FOR J:=I STEP 4 UNTIL N DO 00800600170222PK
|
|
BEGIN 00800700
|
|
L:= I-J; K:= I+J; 00800800170222PK
|
|
SUM:= R[1]**K + 1.5*R[18]**K*COS(DEGREE34*L) 00800900170222PK
|
|
+ 0.5*R[29]**K*COS(DEGREE45*L); 00801000170222PK
|
|
FOR M:=2 STEP 1 UNTIL 17 DO 00801100170222PK
|
|
SUM:= SUM + 2.0*R[M]**K*COS((M-1)*DEGREE2*L); 00801200170222PK
|
|
FOR M:=19 STEP 1 UNTIL 28 DO 00801300170222PK
|
|
SUM:= SUM + R[M]**K*COS((DEGREE34 + (M-18)*DEGREE1)*L); 00801400170222PK
|
|
FA[I,J]:= (8.0/K)*DEGREE1*SUM 00801500170222PK
|
|
END; 00801600
|
|
WRITE (OUTPUT[SPACE 2]); 00801700170222PK
|
|
WRITE (OUTPUT, FTITLE); 00801800
|
|
WRITE (OUTPUT, VECTOR, FRESULTS); 00801900
|
|
FOR J:=1 STEP 1 UNTIL N DO 00802000170222PK
|
|
B[1,J]:= FA[1,J]; 00802100170222PK
|
|
FOR I:=2 STEP 1 UNTIL N DO 00802200170222PK
|
|
BEGIN 00802300
|
|
FOR J:=1 STEP 1 UNTIL I-1 DO 00802400170222PK
|
|
B[I,J]:= -B[J,I]/B[J,J]; 00802500170222PK
|
|
FOR J:=I STEP 1 UNTIL N DO 00802600170222PK
|
|
BEGIN 00802700
|
|
B[I,J]:= FA[I,J]; 00802800170222PK
|
|
FOR K:=1 STEP 1 UNTIL I-1 DO 00802900170222PK
|
|
B[I,J]:= B[I,J] + B[I,K]*B[K,J] 00803000170222PK
|
|
END; 00803100
|
|
FOR J:=1 STEP 1 UNTIL I-1 DO 00803200170222PK
|
|
B[I,J]:= B[I,J]*SQRT(B[J,J]/B[I,I]) 00803300170222PK
|
|
END; 00803400
|
|
FOR I:=1 STEP 1 UNTIL N DO 00803500170222PK
|
|
B[I,I]:= 1.0/(SQRT(B[I,I])*I); 00803600170222PK
|
|
WRITE (OUTPUT, BTITLE); 00803700
|
|
WRITE (OUTPUT, VECTOR, BRESULTS); 00803800
|
|
FOR I:=1 STEP 1 UNTIL N DO 00803900170222PK
|
|
FOR J:=1 STEP 1 UNTIL N DO 00804000170222PK
|
|
A[I,J]:= 0; 00804100170222PK
|
|
A[1,1]:= B[1,1]; 00804200170222PK
|
|
FOR I:=2 STEP 1 UNTIL N DO 00804300170222PK
|
|
BEGIN 00804400
|
|
FOR J:=1 STEP 1 UNTIL I-1 DO 00804500170222PK
|
|
BEGIN 00804600
|
|
A[I,J]:= 0; 00804700170222PK
|
|
FOR K:=J STEP 1 UNTIL I-1 DO 00804800170222PK
|
|
A[I,J]:= A[I,J] + B[I,K]*A[K,J] 00804900170222PK
|
|
END; 00805000
|
|
A[I,I]:= B[I,I] 00805100170222PK
|
|
END; 00805200
|
|
WRITE (OUTPUT[SPACE 2]); 00805300170222PK
|
|
WRITE (OUTPUT, ATITLE); 00805400
|
|
WRITE (OUTPUT, VECTOR, ARESULTS); 00805500
|
|
00805600
|
|
COMMENT NOW CONSTRUCT THE APROXIMATION TO THE SOLUTION; 00805700
|
|
00805800
|
|
FOR J:=4 STEP 4 UNTIL N-1 DO 00805900170222PK
|
|
BEGIN 00806000
|
|
DSUM[J]:= 0; 00806100170222PK
|
|
FOR M:=1 STEP 1 UNTIL 17 DO 00806200170222PK
|
|
DSUM[J]:= DSUM[J] + (R[M]**2 + R[M+1]**2)* 00806300170222PK
|
|
(R[M+1]**J*SIN(M*DEGREE2*J) 00806400170222PK
|
|
- R[M]**J*SIN((M-1)*DEGREE2*J)); 00806500170222PK
|
|
FOR M:=18 STEP 1 UNTIL 28 DO 00806600170222PK
|
|
DSUM[J]:= DSUM[J] + (R[M]**2 + R[M+1]**2*(R[M+1]**J* 00806700170222PK
|
|
SIN((DEGREE34 + (M-17)*DEGREE1)*J) 00806800170222PK
|
|
- R[M]**J*SIN((DEGREE34 00806900170222PK
|
|
+ (M-18)*DEGREE1)*J))) 00807000170222PK
|
|
END; 00807100
|
|
FOR NU:=4 STEP 4 UNTIL N-1 DO 00807200170222PK
|
|
BEGIN 00807300
|
|
HA[2*NU-1]:= 0; 00807400170222PK
|
|
FOR J:=4 STEP 4 UNTIL NU DO 00807500170222PK
|
|
HA[2*NU-1]:= HA[2*NU-1] + A[NU,J]*DSUM[J]; 00807600170222PK
|
|
HA[2*NU-1]:= 4.0*HA[2*NU-1] 00807700170222PK
|
|
END; 00807800
|
|
WRITE (OUTPUT, COEFTITLE); 00807900
|
|
WRITE (OUTPUT, VECTOR, COEFFS); 00808000
|
|
FOR J:=4 STEP 4 UNTIL N-1 DO 00808100170222PK
|
|
BEGIN 00808200
|
|
HAA[J]:= 0; 00808300170222PK
|
|
FOR NU:=J STEP 4 UNTIL N-1 DO 00808400170222PK
|
|
HAA[J]:= HAA[J] + HA[2*NU-1]*A[NU,J] 00808500170222PK
|
|
END; 00808600
|
|
FOR M:=1 STEP 1 UNTIL 18 DO 00808700170222PK
|
|
BEGIN 00808800
|
|
HFN[M]:= 0; 00808900170222PK
|
|
FOR J:=4 STEP 4 UNTIL N-1 DO 00809000170222PK
|
|
HFN[M]:= HFN[M] + HAA[J]*R[M]**J*COS((M-1)*DEGREE2*J) 00809100170222PK
|
|
END; 00809200
|
|
FOR M:=19 STEP 1 UNTIL 29 DO 00809300170222PK
|
|
BEGIN 00809400
|
|
HFN[M]:= 0; 00809500170222PK
|
|
FOR J:=4 STEP 4 UNTIL N-1 DO 00809600170222PK
|
|
HFN[M]:= HFN[M] + HAA[J]*R[M]**J* 00809700170222PK
|
|
COS((DEGREE34 + (M-18)*DEGREE1)*J) 00809800170222PK
|
|
END; 00809900
|
|
WRITE (OUTPUT[SPACE 2]); 00810000170222PK
|
|
WRITE (OUTPUT, BDYVALUES); 00810100
|
|
WRITE (OUTPUT, VECTOR, HFNRES); 00810200
|
|
AVT:= 0; 00810300170222PK
|
|
FOR M:=1 STEP 1 UNTIL 29 DO 00810400170222PK
|
|
AVT:= AVT + R[M]**2 - HFN[M]; 00810500170222PK
|
|
CONST:= AVT/29.0; 00810600170222PK
|
|
WRITE (OUTPUT, CONTITLE); 00810700
|
|
WRITE (OUTPUT, VECTOR, CRES); 00810800
|
|
FOR M:=1 STEP 1 UNTIL 29 DO 00810900170222PK
|
|
HFN[M]:= CONST + HFN[M]; 00811000170222PK
|
|
WRITE (OUTPUT, CBDYVALUES); 00811100
|
|
WRITE (OUTPUT, VECTOR, HFNRES); 00811200
|
|
FOR I:=1 STEP 1 UNTIL 5 DO 00811300170222PK
|
|
BEGIN 00811400
|
|
TH:= 5*(I-1); 00811500170222PK
|
|
FOR J:=1 STEP 1 UNTIL 5 DO 00811600170222PK
|
|
BEGIN 00811700
|
|
HFCN[J]:= CONST; 00811800170222PK
|
|
FOR M:=4 STEP 4 UNTIL N-1 DO 00811900170222PK
|
|
HFCN[J]:= HFCN[J] + HAA[M]*(0.5*J)**M*COS((I-1)*DEGREE5*M) 00812000170222PK
|
|
END; 00812100
|
|
WRITE (OUTPUT[SPACE 2]); 00812200170222PK
|
|
WRITE (OUTPUT, TABLEHEAD); 00812300
|
|
WRITE (OUTPUT, TABLELINE); 00812400
|
|
WRITE (OUTPUT, TABLETH); 00812500
|
|
WRITE (OUTPUT, TABLE, HFCNRES) 00812600
|
|
END; 00812700
|
|
FOR I:=6 STEP 1 UNTIL 10 DO 00812800170222PK
|
|
BEGIN 00812900
|
|
TH:= 5*(I-1); 00813000170222PK
|
|
FOR J:=1 STEP 1 UNTIL 6 DO 00813100170222PK
|
|
BEGIN 00813200
|
|
HFCEN[J]:= CONST; 00813300170222PK
|
|
FOR M:=4 STEP 4 UNTIL N-1 DO 00813400170222PK
|
|
HFCEN[J]:= HFCEN[J] + HAA[M]*(0.5*J)**M* 00813500170222PK
|
|
COS((I-1)*DEGREE5*M) 00813550170222PK
|
|
END; 00813600
|
|
WRITE (OUTPUT, TABLE, HFCNRES) 00813700
|
|
END; 00813800
|
|
GO TO RDIM; 00813900
|
|
00899000
|
|
FINISH: 00899100
|
|
END. 00899800
|