[Fortran] 纯文本查看 复制代码
real a(70,70),y(70)
dimension s(70),nx(70),ny(70)
CHARACTER*15 FILE1,file2
write(*,*)'(yang pin)N,(bian liang)M=?'
read(*,*)n,m
print*,'file1.old=?'
read(*,'(a)') file1
open(3,file=file1,status='old')
c read(3,*)((a(i,j),j=1,m),i=1,n)
read(3,*)((a(i,j),i=1,n),j=1,m)
read(3,*)(s(i),i=1,m)
close(3)
print*,'file2.new=?'
read(*,'(a)') file2
open(5,file=file2,status='new')
write(5,*)' YUAN SHI SHU JU '
c CALL PIR(A,N,M,70,70)
call lxd(a,s,y,n,m)
do 20 i=1,m
20 nx(i)=i
do 25 i=1,n
25 ny(i)=i
do 30 i=1,m-1
do 40 j=i+1,m
if(s(j).gt.s(i)) then
t=s(i)
s(i)=s(j)
s(j)=t
nt=nx(i)
nx(i)=nx(j)
nx(j)=nt
end if
40 continue
30 continue
do 50 i=1,n-1
do 60 j=i+1,n
if(y(j).gt.y(i)) then
t=y(i)
y(i)=y(j)
y(j)=t
nt=ny(i)
ny(i)=ny(j)
ny(j)=nt
end if
60 continue
50 continue
s(m+1)=0.0
y(n+1)=0.0
write(5,*)'* * quan xi shu * *'
write(5,*)' s(i) s(i)-s(i+1)'
do 70 i=1,m
70 write(5,100) i,nx(i),s(i),s(i)-s(i+1)
write(5,*)'* * dei xiang quan * *'
write(5,*)' y(i) y(i)-y(i+1)'
do 80 i=1,n
80 write(5,100) i,ny(i),y(i),y(i)-y(i+1)
100 format('(',i3,')','(',i3,')',2f8.4)
write(5,200) n,m
200 format('n=',i4,'m=',i4)
end
c
subroutine lxd(x,d,y,n,m)
real x(70,70),y(70),d(70)
do 1 i=1,n
y(i)=0.0
do 1 j=1,m
y(i)=y(i)+x(i,j)*d(j)
1 continue
return
end
c
subroutine pir(r,n,m,N1,M1)
real r(N1,M1)
do 100 ib=1,m,10
ie=ib+9
if(ie-m) 2,2,1
1 ie=m
2 write(5,4) (i,i=ib,ie)
do 99 j=1,n
write(5,5) j,(r(j,k),k=ib,ie)
99 continue
100 continue
4 format(5x,10i8)
5 format(i5,10f8.4)
RETURN
end