Question

试用高斯消元法编制Fortran程序计算n元一次方程组的解，并用一个三元一次方程组检验程序？

要求：1，方程组的系数矩阵和右端项存在数据文件中，程序能从数据文件读入数据并把计算结果写入该数据文件。2，使用子程序进行模块化编程。

Answer 1

program gauss
implicit real(kind=8)(a-z)
integer,parameter:: N=3
integer::i,j
real(kind=8) ::A(N,N),b(N),x(N)
open(unit=11,file='fin.txt')
open(unit=12,file='fout.txt')
read(11,*)
!读入A矩阵
read(11,*)((A(i,j),j=1,N),i=1,n)
!读入B向量
read(11,*) (b(j),j=1,n)
call solve(A,b,x,N)
write(12,999)x
999 format(T5,'高斯消去法计算结果',/,T4,'x=',4(/F12.8))
end program gauss
!子程序---------------
subroutine solve(A,b,x,N)
implicit real*8(a-z)
integer::i,k,N
real(kind=8) ::A(N,N),b(N),x(N)
real(kind=8) ::Aup(N,N),bup(N)
!Ab为增广矩阵 [Ab]
real(kind=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(kind=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

输入数据放在fin.txt 记得开头加！A.B

输出数据自动存放在fout.txt

Answer 2

以下是约当消去法解方程组，供参考。


c	约当削去法解线性方程
c	program jordan 
	real a(5,6)
	data a/1,0,6,0,0,
     1		0,1,0,0,0,
     1		0,0,1,0,0,
     1		0,0,0,1,0,
     1		0,0,0,0,1,
     1		1,1,7,1,1/
	write(*,100)((a(i,j),j=1,6),i=1,5)
	write(*,*)
	call jordan(a,5,6)
	write(*,100)(a(i,6),i=1,5)
100	format(1x,6f10.4)
c	 READ(*,*)
	end

c**********************************************************
C选列主元的约当削去法子程序
	subroutine jordan(A,N,M)
	real A(N,M)
	do 10 K=1,N
		big=abs(A(K,K))
		L=K
		do 5 J=K+1,N
		if (abs(A(J,K)).GT.big) L=J
5		CONTINUE
		IF (L.NE.K) THEN
			DO 15 J=K,N+1
			R=A(K,J)
			A(K,J)=A(L,J)
			A(L,J)=R
15			CONTINUE
		ENDIF
		DO 20 J=N+1,K,-1
20		A(K,J)=A(K,J)/A(K,K)
		DO 40 I=1,N
			IF (I.NE.K) THEN
			DO 30 J=N+1,K,-1
30			A(I,J)=A(I,J)-A(I,K)*A(K,J)
			ENDIF
40		CONTINUE
		write(*,100)((a(iI,jJ),jJ=1,6),iI=1,5)
		WRITE(*,*)
10	CONTINUE
100	format(1x,6f10.4)
	return 
	END

c*********************************************************
c不选主元的约当削去法子程序
	subroutine jor10(a,n,m)
	dimension a(n,m)
	do 10 k=1,n
		do 20 j=n+1,k,-1
20		a(k,j)=a(k,j)/a(k,k)
	do 40 i=1,n
		if (i.ne.k) then
		do 30 j=n+1,k,-1
30		a(i,j)=a(i,j)-a(i,k)*a(k,j)
		endif
40	continue
10	continue
	return
	end

Answer 3

DAETRFYERYERQYRYERYERYEQRYEQQYERYEYREYREEGBFHSDFA