program quan !全主元交换法
implicit none
real(8),dimension(:,:),allocatable::a
real(8),dimension(:),allocatable::b,x_zhen !x_zhen记录x_zhen真正的的按顺序值
integer::i,j,n
print,"输入维度n"
read(,)n
allocate(a(n,n),b(n),x_zhen(n))
print,"输入nn的数组a"
read(,)((a(i,j),j=1,n),i=1,n)
print,"n的数组b"
read(,),b
call quan_z_y(n,a,b,x_zhen)
print,"x的数值为：",x_zhen
end program quan
!****************************************************
subroutine quan_z_y(n,a,b,x_zhen)
implicit none
integer::i,j,k,m,n,l,m_tiao
real(8)::a_max,sum,d
real(8),dimension(n,n)::a
real(8),dimension(n)::b,c,x,x_zhen !x_zhen记录x_zhen真正的的按顺序值
integer,dimension(n)::i_shunxu_x !i_shunxu_x记录x的标号变化
d=0
do k=1,n
c(k)=0
i_shunxu_x(k)=k
end do
do k=1,n-1
a_max=dabs(a(k,k))
m=k
do j=k+1,n
if(a_max<dabs(a(j,k)))then
a_max=dabs(a(j,k))
m=j
end if
end do
if(m/=k)then
do i=k,n
c(i)=a(k,i)
a(k,i)=a(m,i)
a(m,i)=c(i)
end do
d=b(k)
b(k)=b(m)
b(m)=d
end if !判断是否是最大值，否则就交换行
!
a_max=dabs(a(k,k))
m=k
do j=k+1,n
if(a_max<dabs(a(k,j)))then
a_max=dabs(a(k,j))
m=j
end if
end do
if(m/=k)then
do i=k,n
c(i)=a(i,k)
a(i,k)=a(i,m)
a(i,m)=c(i)
end do
l=i_shunxu_x(m)
i_shunxu_x(m)=i_shunxu_x(k)
i_shunxu_x(k)=l !进行标记的交换
end if !判断是否是最大值，否则就交换列
do i=k+1,n
do j=k+1,n
a(i,j)=a(i,j)-a(k,j)a(i,k)/a(k,k)
end do
b(i)=b(i)-b(k)a(i,k)/a(k,k)
a(i,k)=0
end do !进行消元计算
end do
x(n)=b(n)/a(n,n)
do i=n-1,1,-1
sum=0
do j=i+1,n
sum=sum+a(i,j)x(j)
end do
x(i)=(b(i)-sum)/a(i,i)
end do !带回计算
do i=1,n
m_tiao=i_shunxu_x(i)
x_zhen(m_tiao)=x(i)
end do !调整x的顺序正确输出
end subroutine quan_z_y