用高斯消去法求线性方程组的解

黑色童话

external gauss

       character*(20) input,output

       input='test.txt'               !input文件格式：n空格matA空格arrB

       output='result.txt'

       call gauss(input,output)

       end

       !高斯消去法求线性方程组的解matA*arrx=arrB，n*n

       subroutine gauss(input,output)

        character*(20) input,output

        real matA(100,100),arrx(100),arrb(100),arrxx(100)

        integer n,k,i,j,choice

        integer location(100),maxi

        real temp,swap

        write(*,*)'****调用GAUSS函数求解线性方程组'

        !write(*,*)'检验传入数据'

       !write(*,*)'检验matA(i,j)'

        open(10,file=input)

        read(10,*)n

        do i=1,n

        read(10,*) (matA(i,j),j=1,n)

       ! write(*,*) (matA(i,j),j=1,n)

        !if(mata(i,i)==0) choice=1

        enddo  

       !write(*,*)'检验arrb(i)'

        do i=1,n

         read(10,*) arrb(i)

        ! write(*,*) arrb(i)

         location(i)=i           !初始arrx(i)的位置

        enddo

        !print*,'传入数据检验结束'

        close(10)

        do k=1,n-1                  !进行第k次消元

        !  print*,'--------->进行第k次消元，k=',k

          maxi=k

          do i=k,n

               if(matA(i,k)>matA(maxi,k)) then  !第k次消元看第k列

                       maxi=i           !记住最大位置           

                     endif

              enddo

         !  print*,'最大系数位置为',maxi

              !交换行位置

              do j=1,n

                temp=matA(k,j)

                matA(k,j)=matA(maxi,j)

                matA(maxi,j)=temp

              enddo

              temp=arrb(k)

           arrb(k)=arrb(maxi)

          arrb(maxi)=temp         

      

           !记住原本arrX(i)交换后的位置

           location(maxi)=k

           location(k)=maxi

                                              !开始消元

          do i=k+1,n

              arrb(i)=arrb(i)-arrb(k)*mata(i,k)/matA(k,k)

             do j=k+1,n

               mata(i,j)=mata(i,j)-mata(k,j)*mata(i,k)/mata(k,k)

             enddo

             mata(i,k)=0

           enddo

        enddo

        !输出消元结果

        print*,'**************最终消元结果*****************'

        do i=1,n

          write(*,*) '',i

          write(*,*) (mata(i,j),j=1,n),arrb(i)

        enddo

        print*,'**************最终消元结果*****************'

       !回代方程

        arrx(n)=arrb(n)/mata(n,n)

       do i=n-1,1,-1

          temp=0.0

          do j=i+1,n

            temp=temp+mata(i,j)*arrx(j)

          enddo

          arrx(i)=(arrb(i)-temp)/mata(i,i)

        enddo

        write(*,"(<n>f8.4,10x)")  ((mata(i,j),j=1,n),i=1,n)

       write(*,*) (arrb(i),i=1,n)

        write(*,*)'GAUSS函数求解结果'

        open(20,file=output)

        write(20,*) n

        !还原到初始位置

        do i=1,n

          arrxx(location(i))=arrx(location(i))

        enddo

         !输出最终结果

        do i=1,n

          write(*,*) arrxx(i)

          write(20,*) arrxx(i)

        enddo

        close(20)

        write(*,*)'***************高斯消元法调用结束******************'

        return

       end subroutine gauss