Web pdp-10.trailing-edge.com

Trailing-Edge - PDP-10 Archives - red405a2 - uetp/lib/adpr12.alg
```BEGIN
LONG REAL	X1,X2,X3,X4,X,Y,Z,T,T1,T2;
LONG REAL ARRAY	A1[1:4];
INTEGER	I,J,K,L,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12;
PROCEDURE PA(A);
LONG REAL ARRAY A;
BEGIN INTEGER J;
J:=0;
LAB:	A[1]:=(A[1]+A[2]+A[3]-A[4])*T;
A[2]:=(A[1]+A[2]-A[3]+A[4])*T;
A[3]:=(A[1]-A[2]+A[3]+A[4])*T;
A[4]:=(-A[1]+A[2]+A[3]+A[4])*T;
J:=J+1;
IF J<6 THEN GOTO LAB;
END	PROCEDURE PA;
PROCEDURE PO;
BEGIN	A1[J]:=A1[K];
A1[K]:=A1[L];
A1[L]:=A1[J];
END	PROCEDURE PO;
PROCEDURE P3(X,Y,Z);
VALUE X,Y;
LONG REAL	X,Y,Z;
BEGIN	X:=T*(X+Y);
Y:=T*(X+Y);
Z:=(X+Y)/T2;
END 	PROCEDURE P3;
PROCEDURE POUT(N,J,K,X1,X2,X3,X4);
VALUE	N,J,K,X1,X2,X3,X4;
INTEGER	N,J,K;
LONG REAL	X1,X2,X3,X4;
BEGIN
COMMENT		THIS PROCEDURE PRINTS OUT THE VALUES OF N,J,K,
X1,X2,X3,X4 FORMAT AND MEDIUM ARE UNIMPORTANT;
PRINT(N);
SPACE(2);
PRINT(J);
SPACE(2);
PRINT(K);
SPACE(2);
PRINT(X1);
SPACE(2);
PRINT(X2);
SPACE(2);
PRINT(X3);
SPACE(2);
PRINT(X4);
NEWLINE(1);
END	PROCEDURE POUT;
COMMENT INITIALISE CONSTANTS;
T:=0.499975;
T1:=0.50025;
T2:=2.0;
COMMENT READ VALUES OF I CONTROLLING TOTAL WEIGHT;
COMMENT IF I = 10 THE TOTAL WEIGHT IS ONE MILLION WHETSTONE INSTRUCTIONS;
OUTPUT(1,"DSK");
SELECTOUTPUT(1);
COMMENT SET VALUES OF MODULE WEIGHTS;
N1:=0;
N2:=12*I;
N3:=14*I;
N4:=345*I;
N5:=0;
N6:=210*I;
N7:=32*I;
N8:=899*I;
N9:=516*I;
N10:=0;
N11:=93*I;
N12:=0;
COMMENT MODULE 1 SIMPLE IDENTIFIERS;
X1:=1.0;
X2:=X3:=X4:=-1.0;
FOR I:=1 STEP 1 UNTIL N1 DO
BEGIN	X1:=(X1+X2+X3-X4)*T;
X2:=(X1+X2-X3+X4)*T;
X3:=(X1-X2+X3+X4)*T;
X4:=(-X1+X2+X3+X4)*T;
END MODULE 1;
POUT(N1,N1,N1,X1,X2,X3,X4);
COMMENT MODULE 2 LONG REAL ARRAY ELEMENTS;
A1[1]:=1.0;
A1[2]:=A1[3]:=A1[4]:=-1.0;
FOR I:=1 STEP 1 UNTIL N2 DO
BEGIN	A1[1]:=(A1[1]+A1[2]+A1[3]-A1[4])*T;
A1[2]:=(A1[1]+A1[2]-A1[3]+A1[4])*T;
A1[3]:=(A1[1]-A1[2]+A1[3]+A1[4])*T;
A1[4]:=(-A1[1]+A1[2]+A1[3]+A1[4])*T;
END	MODULE 2;
POUT(N2,N3,N2,A1[1],A1[2],A1[3],A1[4]);
COMMENT MODULE 3 LONG REAL ARRAY AS PARAMETER;
FOR I:=1 STEP 1 UNTIL N3 DO
PA(A1);
POUT(N3,N2,N2,A1[1],A1[2],A1[3],A1[4]);
COMMENT MODULE 4 CONDITIONAL JUMP;
J:=1;
FOR I:=1 STEP 1 UNTIL N4 DO
BEGIN	IF J=1 THEN J:=2 ELSE J:=3;
IF J>2 THEN J:=0 ELSE J:=1;
IF J<1 THEN J:=1 ELSE J:=0;
END	MODULE 4;
POUT(N4,J,J,X1,X2,X3,X4);
COMMENT MODULE 5 OMMITTED;
COMMENT MODULE 6 INTEGER ARITHMETIC;
J:=1;
K:=2;
L:=3;
FOR I:=1 STEP 1 UNTIL N6 DO
BEGIN	J:=J*(K-J)*(L-K);
K:=L*K-(L-J)*K;
L:=(L-K)*(K+J);
A1[L-1]:=J+K+L;
A1[K-1]:=J*K*L;
END	MODULE 6;
POUT(N6,J,K,A1[1],A1[2],A1[3],A1[4]);
COMMENT MODULE 7 TRIG FUNCTIONS;
X:=Y:=0.5;
FOR I:=1 STEP 1 UNTIL N7 DO
BEGIN
X:=T*ARCTAN(T2*SIN(X)*COS(X)/(COS(X+Y)+COS(X-Y)-1.0));
Y:=T*ARCTAN(T2*SIN(Y)*COS(Y)/(COS(X+Y)+COS(X-Y)-1.0));
END	MODULE 7;
POUT(N7,J,K,X,X,Y,Y);
COMMENT MODULE 8PROCEDURE CALLS;
X:=Y:=Z:=1.0;
FOR I:=1 STEP 1 UNTIL N8 DO
P3(X,Y,Z);
POUT(N8,J,K,X,Y,Z,Z);
COMMENT MODULE 9 LONG REAL ARRAY REFERENCES;
J:=1;
K:=2;
L:=3;
A1[1]:=1.0;
A1[2]:=2.0;
A1[3]:=3.0;
FOR I:=1 STEP 1 UNTIL N9 DO
PO;
POUT(N9,J,K,A1[1],A1[2],A1[3],A1[4]);
COMMENT MODULE 10 INTEGER ARITHMETIC;
J:=2;
K:=3;
FOR I:=1 STEP 1 UNTIL N10 DO
BEGIN
J:=J+K;
K:=J+K;
J:=K-J;
K:=K-J-J;
END	MODULE 10;
POUT(N10,J,K,X1,X2,X3,X4);
COMMENT MODULE 11 STANDARD FUNCTIONS;
X:=0.75;
FOR I:=1 STEP 1 UNTIL N11 DO
X:=SQRT(EXP(LN(X)/T1));
POUT(N11,J,K,X,X,X,X);
END;

```