PROGRAM SOLVE

REAL A(2500), B(50), X(50)

INTEGER I, J, N, IERR, IPIV(50)

PRINT *, 'INPUT N'

READ *, N

DO 10 I=1,N

PRINT *, 'INPUT COEF FOR ROW ', I

READ *, (A(N*(J-1)+I), J=1,N)

PRINT *, 'INPUT B(', I, ')'

READ *, B(I)

10 CONTINUE

PRINT *, 'THE SOLUTION TO:'

DO 20 I=1,N

PRINT *, (A(N*J-N+I), J=1,N), ' |', B(I)

20 CONTINUE

CALL GAUSS(A, N, B, X, IPIV, IERR)

PRINT *, 'IS:'

IF (IERR .NE. 0) THEN

PRINT *, 'NO SOLUTION'

ELSE

PRINT *, (X(I), I=1,N)

ENDIF

END

SUBROUTINE GAUSS(A, N, B, X, IPIV, IERR)

INTEGER N, I, J, K, L, IPIV(1)

REAL A(N,1), B(1), X(1), AA

IERR = 0

C INITIALIZE PIVOT ARRAY

DO 10 I=1,N

10 IPIV(I) = I

C FORWARD ELIMINATION

DO 50 I=1,N-1

DO 50, J=I+1, N

IF (A(IPIV(I),I) .EQ. 0.0) THEN

DO 20 K=I+1, N

IF (A(IPIV(K),I) .NE. 0.0) THEN

L = IPIV(K)

IPIV(K) = IPIV(I)

IPIV(I) = L

GOTO 30

ENDIF

20 CONTINUE

IERR = -1

RETURN

ENDIF

30 AA = A(IPIV(J),I) / A(IPIV(I),I)

DO 40 K=I+1, N

A(IPIV(J),K) = A(IPIV(J),K) - AA * A(IPIV(I),K)

40 CONTINUE

B(IPIV(J)) = B(IPIV(J)) - AA * B(IPIV(I))

50 CONTINUE

C BACK SUBSTITUTION

IF (A(IPIV(N),N) .EQ. 0.0) THEN

IERR = -1

RETURN

ENDIF

X(N) = B(IPIV(N)) / A(IPIV(N),N)

DO 70 I=N-1, 1, -1

DO 60 J=I+1, N

B(IPIV(I)) = B(IPIV(I)) - A(IPIV(I),J) * X(J)

60 CONTINUE

X(I) = B(IPIV(I)) / A(IPIV(I),I)

70 CONTINUE

END