求助!出现错误#6552

yl又在做实习

[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

fcode

1. 不同的编译器，错误代码不同。所以请给出详细的错误信息提示，错误截图。
2. 代码要做好缩进，美观。
3. 如果代码中出现多个相同的常数，比如 13，建议定义一个常量来代替，方便修改。
4. Fortran是矢量化的语言，要合理的使用数组整体操作，数组片段，以及 sum 这种矢量化的内部函数，让代码简短、更易读。

[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