逆迭代法Fortran实现

programmainuseLinearAlgebraimplicitnoneinteger,parameter::n=4integer::i,j,p!循环变量real::error,factor!误差，精度real::q1,q2,q(1000)real::m(n,n),k(n,n),x1(n),y1(n),y2(n),x0(n)datam/0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,1/datak/2,-1,0,0,-1,2,-1,0,0,-1,2,-1,0,0,-1,1/write(*,*)Entertheinitialvector:read(*,*)x1write(*,*)Enterthefactor:read(*,*)factory1=matmul(m,x1)q(1)=10000p=1error=1!开始迭代dowhile(error=factor)p=p+1x1=Gauss(k,y1,n)y2=matmul(m,x1)q1=dot_product(x1,y1)q2=dot_product(x1,y2)q(p)=q1/q2y1=y2/sqrt(q2)error=abs((q(p)-q(p-1))/q(p))!误差项enddox0=x1/sqrt(q2)!特征向量write(*,*)M:,Mwrite(*,*)K:,Kwrite(*,*)Eigenvalue:,q(p)write(*,*)Eigenvector:,x0pauseendprogrammoduleLinearAlgebraimplicitnonecontainsfunctionGauss(A0,B0,n)result(x)!高斯消元，必须保证系数矩阵非奇异implicitnoneinteger::n,i,j,k,isreal::A0(n,n),B0(n)real::A(n,n),B(n),x(n),js(n)real::d,tA=A0B=B0dok=1,n-1d=0.0doi=k,ndoj=k,nif(abs(a(i,j))d)thend=abs(a(i,j))js(k)=jis=iendifenddoenddo!把行绝对值最大的元素换到主元位置if(js(k)/=k)thendoi=1,nt=a(i,k)a(i,k)=a(i,js(k))a(i,js(k))=tenddo!最大元素不在K行，K行endifif(is/=k)thendoj=k,nt=a(k,j)a(k,j)=a(is,j)a(is,j)=t!交换到K列enddot=b(k)b(k)=b(is)b(is)=tendif!最大元素在主对角线上doj=k+1,na(k,j)=a(k,j)/a(k,k)enddob(k)=b(k)/a(k,k)!求三角矩阵doi=k+1,ndoj=k+1,na(i,j)=a(i,j)-a(i,k)*a(k,j)enddob(i)=b(i)-a(i,k)*b(k)enddoenddox(n)=b(n)/a(n,n)doi=n-1,1,-1t=0.0doj=i+1,nt=t+a(i,j)*x(j)enddox(i)=b(i)-tenddojs(n)=ndok=n,1,-1if(js(k)/=k)thent=x(k)x(k)=x(js(k))x(js(k))=tendifenddoreturnendfunctionendmodule