Google
 

Trailing-Edge - PDP-10 Archives - ALGOL-20_29Jan82 - algol-uetp/adpr12.alg
There are 20 other files named adpr12.alg in the archive. Click here to see a list.
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;
	READ(I);
	OUTPUT(1,"DSK");
	OPENFILE(1,"ADPR12.DAT");
	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;