2 COMMENT FOURTH EXAMPLE PROGRAM FROM BALGOL MANUAL, MARCH 1963.
2         NOTE THAT THIS REQUIRES A SYSTEM WITH AT LEAST 8000 WORDS.
2
2 THE PROGRAM BELOW HAS BEEN WRITTEN BY G. FORSYTHE, OF STANFORD
2 UNIVERSITY. IT SOLVES A SET OF LINEAR EQUATIONS OF THE FORM AY = B,
2 USING CROUT'S METHOD WITH INTERCHANGES;
2
2 COMMENT FORSYTHE PROGRAM;
2 PROCEDURE PRODUCT (; N, A(), P, E);
2   BEGIN COMMENT THIS FORMS THE PRODUCT OF ARBITRARY FLOATING NUMBERS
2       A(I), FOR I=(1,1,N). EXPONENT OVERFLOW OR UNDERFLOW IS
2       PREVENTED. THE ANSWER IS P TIMES 10*E WHERE E IS 0 IF POSSIBLE.
2       IF E NEQ 0, THEN WE NORMALIZE P SO THAT 0.1 LEQ ABS(P) LSS 1.0;
2   INTEGER E, F, I, K, N;
2
2   Q = 1.0**-10; F = 10;
2   FOR I = (1,1,N);
2     BEGIN
2     IF A(I) EQL 0.0;
2       BEGIN
2       P = 0.0;
2       E = 0;
2       RETURN
2       END;
2
2     IF ABS(A(I)) LEQ 1.0;
2       BEGIN
2       F = F-20;
2       Q = Q.(10.0*20)
2       END;
2
2     Q = Q.A(I);
2     X = ABS(Q);
2     FOR K = (-10,1,10), (-11,-1,-41), (11,1,41);
2       IF ((10.0*K LEQ X) AND (X LSS 10.0*(K+1)));
2         BEGIN
2         Q = Q.(10.0*(-10-K));
2         F = F + K + 10;
2         GO TO 1
2         END;
2 1.. END;
2
2   IF (((-40) LEQ F) AND (F LEQ 58));
2     BEGIN
2     P = (Q.(10.0*9)).(10.0*(F-9));
2     E = 0;
2     RETURN
2     END;
2
2   P = Q.(10.0*9);
2   E = F - 9;
2   RETURN
2   END PRODUCT();
2
2 PROCEDURE INNERPRODUCT (S, F, U(), V());
2   BEGIN COMMENT THIS FORMS THE INNER PRODUCT OF THE VECTORS
2       U(I) AND V(I) FOR I = (S,1,F);
2   INTEGER I, S, F;
2
2   SUM = 0.0;
2   FOR I = (S,1,F);
2     SUM = SUM + U(I).V(I);
2   INNERPRODUCT() = SUM;
2   RETURN
2   END INNERPRODUCT();
2
2 PROCEDURE CROUT4 (; N, A(,), B(), Y(), PIVOT(), DET, EX7;
2                   SINGULAR, IP());
2   BEGIN COMMENT THIS IS CROUTS METHOD WITH INTERCHANGES, TO SOLVE
2       AY = B AND OBTAIN THE TRIANGULAR DECOMPOSITION. IP() STANDS FOR
2       AN INNERPRODUCT ROUTINE THAT MUST BE AVAILABLE WHEN CROUT4() IS
2       CALLED. ALSO, PRODUCT() MUST BE AVAILABLE. THE DETERMINANT OF A
2       IS COMPUTED IN THE FORM DET TIMES 10*EX7, WHERE EX7 IS 0 IF
2       POSSIBLE. IF EX7 NEQ 0, THEN WE NORMALIZE DET WITH 0.1 LEQ
2       ABS(DET) LSS 1;
2   INTEGER K, I, J, IMAX, N, PIVOT;
2   INTEGER EX7;
2
2   INT = 1.0;
2   FOR K = (1,1,N);
2     BEGIN
2     TEMP = 0;
2     FOR I = (K,1,N);
2       BEGIN
2       A(I,K) = A(I,K) - IP(1, K-1, A(I,), A(,K));
2       IF ABS(A(I,K)) GTR TEMP;
2         BEGIN
2         TEMP = ABS(A(I,K));
2         IMAX = I
2         END
2       END;
2
2     PIVOT(K) = IMAX;
2     COMMENT WE HAVE FOUND THAT A(IMAX,K) IS THE LARGEST PIVOT IN COL
2         K. NOW WE INTERCHANGE ROWS K AND IMAX;
2     IF IMAX NEQ K;
2       BEGIN
2       INT = -INT;
2       FOR J = (1,1,N);
2         BEGIN
2         TEMP = A(K,J);
2         A(K,J) = A(IMAX,J);
2         A(IMAX,J) = TEMP
2         END;
2
2       TEMP = B(K);
2       B(K) = B(IMAX);
2       B(IMAX) = TEMP
2       END;
2
2     COMMENT NOW FOR THE ELIMINATION;
2     IF A(K,K) EQL 0;
2       BEGIN
2       DET = 0.0;
2       EX7 = 0;
2       GO TO SINGULAR;
2       END;
2
2     FOR I = (K+1,1,N);
2       BEGIN
2       XX = A(I,K);
2       XY = A(K,K);
2       X = 1.0;
2       X = X.X;
2       A(I,K) = XX/XY
2       END;
2
2     FOR J = (K+1,1,N);
2       A(K,J) = A(K,J) - IP(1, K-1, A(K,), A(,J));
2
2     B(K) = B(K) - IP(1, K-1, A(K,), B())
2     END;
2
2   FOR I = (1,1,N);
2     Y(I) = A(I,I);
2   PRODUCT (; N, Y(), DET, EX7);
2   DET = INT.DET;
2
2   COMMENT NOW FOR THE BACK SUBSTITUTION;
2   FOR K = (N,-1,1);
2     BEGIN
2     XX = B(K) - IP(K+1, N, A(K,), Y());
2     XY = A(K,K);
2     X = 1.0;
2     X = X.X;
2     Y(K) = XX/XY
2     END;
2
2   RETURN;
2   END CROUT4();
2
2 PROCEDURE SOLV2 (; N, B(,), C(), PIVOT(), Z(); IP());
2   BEGIN COMMENT IT IS ASSUMED THAT A MATRIX A HAS ALREADY BEEN
2       TRANSFORMED INTO B BY CROUT, BUT THAT A NEW COLUMN C HAS
2       NOT BEEN PROCESSED. SOLV2() SOLVES THE SYSTEM BZ = C.
2       AN INNERPRODUCT PROCEDURE MUST BE USED WITH SOLV2();
2   INTEGER K, N, PIVOT;
2
2   FOR K = (1,1,N);
2     BEGIN
2     TEMP = C(PIVOT(K));
2     C(PIVOT(K)) = C(K);
2     C(K) = TEMP;
2     C(K) = C(K) - IP(1, K-1, B(K,), C())
2     END;
2
2   FOR K = (N,-1,1);
2     Z(K) = (C(K) - IP(K+1, N, B(K,), Z()))/B(K,K);                            *WAS N,B(K), *
2   RETURN
2   END SOLV2();
2
2 COMMENT FORSYTHE TEST CROUT US169 EXT 2274;
2 FORMAT FRMTFL (W0, (6F19.8, W0));
2 FORMAT FRMTFX (W0, (6I19, W0));
2 INTEGER PIVOT();
2 INTEGER EX;
2 INTEGER I, J, N;
2 ARRAY A(70,70), B(70), Y(70), C(70), PIVOT(70);                               *WAS A(70,70, B(*
2 INPUT DATA (N, FOR I=(1,1,N); (FOR J=(1,1,N); A(I,J), B(I)));
2 INPUT VECTOR (N, FOR I=(1,1,N); C(I));
2
2 START..
2   READ (;; DATA);
2   READ (;; VECTOR);
2   OUTPUT ORDER (N);
2   OUTPUT DATAO (FOR I=(1,1,N); (FOR J=(1,1,N); A(I,J), B(I)));
2   OUTPUT VECTORO (FOR I=(1,1,N); C(I));
2   WRITE (;; ORDER, FRMTFX);
2   WRITE (;; DATAO, FRMTFL);
2   WRITE (;; ORDER, FRMTFX);
2   WRITE (;; VECTORO, FRMTFL);
2   CROUT4 (; N, A(,), B(), Y(), PIVOT(), DET, EX;
2           SINGULAR, INNERPRODUCT());
2   WRITE (;; DATAO, FRMTFL);
2   OUTPUT ANSWER (FOR I=(1,1,N); Y(I));
2   OUTPUT PIVOTO (N, FOR I=(1,1,N); PIVOT(I));
2   OUTPUT DETO (DET);
2   OUTPUT EXPO (EX);
2   WRITE (;; PIVOTO, FRMTFX);
2   WRITE (;; ANSWER, FRMTFL);
2   WRITE (;; DETO, FRMTFL);
2   WRITE (;; EXPO, FRMTFX);
2   SOLV2 (; N, A(,), C(), PIVOT(), Y(); INNERPRODUCT());
2   WRITE (;; VECTORO, FRMTFL);
2   WRITE (;; ANSWER, FRMTFL);
2   GO TO START;
2
2 SINGULAR..
2   WRITE (;; FRMTSI);
2   FORMAT FRMTSI (W0, *SINGULAR*, W0);
2   GO TO START;
2 FINISH;
5 4
5   9.   3.   3.   3.  24.
5   3.  10.  -2.  -2.  17.
5   3.  -2.  18.  10.  45.
5   3.  -2.  10.  10.  29.
5 4
5  24.  17.  45.  29.
