请选择 进入手机版 | 继续访问电脑版
爱气象,爱气象家园! 

气象家园

 找回密码
 立即注册

QQ登录

只需一步,快速开始

新浪微博登陆

只需一步, 快速开始

搜索
查看: 3688|回复: 0

[源代码] 用高斯消去法求线性方程组的解

[复制链接]

新浪微博达人勋

发表于 2017-8-13 21:17:41 | 显示全部楼层 |阅读模式

登录后查看更多精彩内容~

您需要 登录 才可以下载或查看,没有帐号?立即注册 新浪微博登陆

x
external gauss
       character*(20) input,output
       input='test.txt'               !input文件格式:n空格matA空格arrB
       output='result.txt'
       call gauss(input,output)
       end
       !高斯消去法求线性方程组的解matA*arrx=arrBn*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
密码修改失败请联系微信:mofangbao
您需要登录后才可以回帖 登录 | 立即注册 新浪微博登陆

本版积分规则

Copyright ©2011-2014 bbs.06climate.com All Rights Reserved.  Powered by Discuz! (京ICP-10201084)

本站信息均由会员发表,不代表气象家园立场,禁止在本站发表与国家法律相抵触言论

快速回复 返回顶部 返回列表