[Fortran] 纯文本查看 复制代码
MODULE GAUSS
CONTAINS
SUBROUTINE SOLVE(A,B,X,N)
IMPLICIT REAL*8(A-Z)
INTEGER::I,K,N
REAL*8::A(N,N),B(N),X(N)
REAL*8::AUP(N,N),BUP(N)
REAL*8::AB(N,N+1)
AB(1:N,1:N)=A
AB(:,N+1)=B
DO K=1,N-1
DO I=K+1,N
TEMP=AB(I,K)/AB(K,K)
AB(I,:)=AB(I,:)-TEMP*AB(K,:)
END DO
END DO
AUP(:,:)=AB(1:N,1:N)
BUP(:)=AB(:,N+1)
CALL UPTRI(AUP,BUP,X,N)
END SUBROUTINE SOLVE
!!!!!!!!!!!!!!!!!!!!!!!
subroutine uptri(a,b,x,n)
IMPLICIT REAL*8(A-Z)
INTEGER::I,J,N
REAL*8::A(N,N),B(N),X(N)
X(N)=B(N)/A(N,N)
DO I=N-1,1,-1
X(I)=B(I)
DO J=I+1,N
X(I)=X(I)-A(I,J)*X(J)
END DO
X(I)=X(I)/A(I,I)
END DO
END SUBROUTINE UPTRI
END MODULE GAUSS
PROGRAM MAIN
USE GAUSS
IMPLICIT REAL*8(A-Z)
INTEGER,PARAMETER::N=4
INTEGER::I,J
REAL*8::A(N,N),B(N),X(N)
OPEN(UNIT=11,FILE='FIN.TXT')
OPEN(UNIT=12,FILE='FOUT.TXT')
READ(11,*)
READ(11,*)((A(I,J),J=1,N),I=1,N)
READ(11,*)B
CALL SOLVE(A,B,X,N)
WRITE(12,101)X
101 FORMAT(T5,'高斯消去法计算结果',/,T4,'X=',4(/F12.8))
END PROGRAM MAIN
