[Fortran] 纯文本查看 复制代码
program TZ5
implicit none
integer i,j,k
real::x(4,13),ax(4)=0,s(4)=0,r(3,4)=0,key(3)
external::linearequations
open(8,file='C:\Users\ASUS\Desktop\QT\shuju5.dat')
read(1,*)((x(j,i),i=1,13),j=1,4)
do j=1,4 !平均
do i=1,13
ax(j)=ax(j)+x(j,i)
end do
ax(j)=ax(j)/13
end do
do j=1,4 !标准差
do i=1,13
s(j)=(x(j,1)-ax(j))**2+s(j)
end do
s(j)=sqrt(s(j)/13)
end do
do j=1,4 !标准化
do i=1,13
x(j,i)=(x(j,i)-ax(j))/s(j)
end do
end do
do i=1,3 !相关距阵
do j=1,4
do k=1,13
r(i,j)=r(i,j)+x(i,k)*x(j,k)
end do
r(i,j)=r(1,j)/13
end do
end do
do i=1,3
do j=1,4
print*,r(i,j)
end do
end do
call linearequations(r,3,key) !求系数向量 （一直报错这一行）
print *,'y=',key(1),'x1' ,'+',key(2),'x2', '+',key (3),'x4'
end program
integer function linearequations(ba,mm,key)
implicit none
integer mm,i,j,k
real ba(mm,mm+1),temp(mm+1),tmp,d(mm),key(mm)
do i=1,mm-1
if(ba(i,i)==0.0) then
do j=i+1,mm
if(ba(j,i)/=0.0) then
temp=ba(i,1:mm+1)
ba(i,1:mm+1)=ba(j,1:mm+1)
ba(j,1:mm+1)=temp
end if
end do
end if
if(ba(i,i)==0.0) then
linearequations=0
return
end if
do j=i+1,mm
tmp=ba(j,i)/ba(i,i)
ba(j,i:mm+1)=ba(j,i:mm+1)-tmp*ba(i,i:mm+1)
end do
end do
d=0
key(mm)=ba(mm,mm+1)/ba(mm,mm)
do i=mm-1,1,-1
do j=mm,i+1,-1
d(i)=d(i)+key(j)*ba(i,j)
end do
key(i)=(ba(i,mm+1)-d(i))/ba(i,i)
end do
linearequations=1
end function linearequations
[Fortran] 纯文本查看 复制代码
program TZ5
implicit none
Integer , parameter :: N = 13 , M = 4 , L = M-1
integer i,j
real::x(M,N),ax(M)=0,s(M)=0,r(L,M)=0,key(L)
external::linearequations
open(8,file='shuju5.dat')
read(8,*)(x(j,:),j=1,M)
do j=1,M !平均
ax(j) = sum(x(j,:))/N
end do
do j=1,M !标准差
do i=1,N
s(j)=(x(j,i)-ax(j))**2+s(j)
end do
s(j)=sqrt(s(j)/N)
end do
do j=1,M !标准化
x(j,:)=(x(j,:)-ax(j))/s(j)
end do
do i=1,L !相关距阵
do j=1,M
r(i,j) = sum(x(i,:)*x(j,:))/N
end do
end do
do i=1,L
print*,r(i,:)
end do
call linearequations(r,L,key) !求系数向量 （一直报错这一行）
print *,'y=',key(1),'x1' ,'+',key(2),'x2', '+',key (3),'x4'
end program TZ5
integer function linearequations(ba,mm,key)
implicit none
integer mm,i,j
real ba(mm,mm+1),temp(mm+1),tmp,d(mm),key(mm)
do i=1,mm-1
if(ba(i,i)==0.0) then
do j=i+1,mm
if(ba(j,i)/=0.0) then
temp=ba(i,1:mm+1)
ba(i,1:mm+1)=ba(j,1:mm+1)
ba(j,1:mm+1)=temp
end if
end do
end if
if(ba(i,i)==0.0) then
linearequations=0
return
end if
do j=i+1,mm
tmp=ba(j,i)/ba(i,i)
ba(j,i:mm+1)=ba(j,i:mm+1)-tmp*ba(i,i:mm+1)
end do
end do
d=0
key(mm)=ba(mm,mm+1)/ba(mm,mm)
do i=mm-1,1,-1
do j=mm,i+1,-1
d(i)=d(i)+key(j)*ba(i,j)
end do
key(i)=(ba(i,mm+1)-d(i))/ba(i,i)
end do
linearequations=1
end function linearequations