Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Fortran 95 source code to solve simultaneous equations by Gauss-Jordan's method(pivot).
!**************************************************************
! Simultaneous equations solving by Gauss-Jorden(pivot) method
!
! date name version
! 2018.12.04 mk-mode.com 1.00 新規作成
!
! Copyright(C) 2018 mk-mode.com All Rights Reserved.
!**************************************************************
!
module const
! SP: 単精度(4), DP: 倍精度(8)
integer, parameter :: SP = kind(1.0)
integer(SP), parameter :: DP = selected_real_kind(2 * precision(1.0_SP))
end module const
module gauss_jordan_pivot
use const
implicit none
private
public :: solve
contains
! 連立方程式を解く
!
! :param(in) integer(4) n: 元数
! :param(inout) real(8) a(n,n+1): 係数配列
subroutine solve(n, a)
implicit none
integer(SP), intent(in) :: n
real(DP), intent(inout) :: a(n, n + 1)
integer(SP) :: i, j, s
real(DP) :: mx, dummy, p, d
do j = 1, n
mx = 0.0_DP
s =j
do i = j, n
if (abs(a(i, j)) <= mx) cycle
mx = abs(a(i, j))
s = i
end do
if (mx == 0.0_DP) then
print *, "Can't solve!"
stop
end if
do i = 1, n + 1
dummy = a(j, i)
a(j, i) = a(s, i)
a(s, i) = dummy
end do
p = a(j, j)
a(j, j:n+1) = a(j, j:n+1) / p
do i = 1, n
if (i == j) cycle
d = a(i, j)
a(i, j:n+1) = a(i, j:n+1) - d * a(j, j:n+1)
end do
end do
end subroutine solve
end module gauss_jordan_pivot
program simultaneous_equations
use const
use gauss_jordan_pivot
implicit none
integer(SP) :: n, i ! 元数、ループインデックス
character(20) :: f ! 書式文字列
real(DP), allocatable :: a(:,:) ! 係数配列
! 元数取得
write (*, '(A)', advance="no") "n ? "
read (*, *) n
! 配列メモリ確保
allocate(a(n, n + 1))
! 係数取得
do i = 1, n
write (*, '("row(", I0, ",1:", I0, ") ? ")', advance="no") i, n + 1
read (*, *) a(i,:)
end do
write (*, '(/A)') "Coefficients:"
write (f, '("(", I0, "(F8.2, 2X)", ")")') n + 1
do i = 1, n
write (*, f) a(i,:)
end do
! 連立方程式を解く
! (計算後 a の最右列が解)
call solve(n, a)
! 結果出力
write (*, '(A)') "Answer:"
write (f, '("(", I0, "(F8.2, 2X)", ")")') n
write (*, f) a(:, n + 1)
! 配列メモリ解放
deallocate(a)
end program simultaneous_equations
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.