ВУЗ: Не указан
Категория: Не указан
Дисциплина: Не указана
Добавлен: 04.04.2021
Просмотров: 736
Скачиваний: 1
a=reshape(source=(/ 1,6,1,1, & !первый столбец матрицы коэф-
фициентов
0,1,1,1, & !второй столбец
2,-1,1,1, & !третий столбец
0,1,0,1/),& !четвертый столбец
shape=(/n,n/)) !форма конечного массива
b=(/1,2,3,4/) !столбец свободных членов
apr=a ! матрица а и столбец b сохраняем для последующей про-
верки
bpr=b
! прямой ход метода Гаусса; диагональный элемент не равен 0
do k=1, n-1
do i=k+1, n
do j=k+1,n
a(i,j)=a(i,j)-a(i,k)/a(k,k)*a(k,j)
end do
b(i)=b(i)-a(i,k)/a(k,k)*b(k)
end do
end do
! обратный ход метода Гаусса
do i=n, 1, -1
s=0.0
do j=i+1, n
s=s+a(i,j)*x(j)
end do
x(i)=(b(i)-s)/a(i,i)
end do
!вывод полученных значений
do i=1, n
write (*, *) "x(",i, ")=", x(i)
end do
! проверка полученных значений
do i=1, n
s=0.0
do j=1, n
s=s+apr(i,j)*x(j)
end do
if (abs(s-bpr(i))<1e-7) then
write (*,*) "stroka", i, "OK"
else
81
write (*,*) "stroka", i, "is wrong"
end if
end do
end ! решение систем линейных алгебраических уравнений методом
прогонки
program progonka
implicit none
integer, parameter :: N=3 !размер системы
real*8 a(n), b(n), c(n), d(n), x(n), apr(n-1), bpr(n-1), e(2:n-1)
integer i
a=(/0.0, 1.0, 2.5/)
b=(/1.0, 2.1, 3.0/)
c=(/-2.4, 1.2, 0.0/)
d=(/2.0, 1.5, 3.5/)
apr(1)=-c(1)/b(1); bpr(1)=d(1)/b(1)
do i=2, N-1
e(i)=a(i)*apr(i-1)+b(i)
apr(i)=-c(i)/e(i)
bpr(i)=(d(i)-a(i)*bpr(i-1))/e(i)
end do
x(n)=(d(n)-a(n)*bpr(n-1))/(b(n)+a(n)*apr(n-1))
do i=n-1, 1, -1
x(i)=apr(i)*x(i+1)+bpr(i)
end do
do i=1, n
write (*,10) "x=(", i, ")=", x(i)
end do !вывод полученных значений
call proverka() !проверка полученных значений
10 format (A, i3, a, f6.3)
contains
subroutine proverka() ! проверка полученных значений
implicit none
integer i, j
real*8 s
do i=1, n
s=0.0
s=s+b(i)*x(i)
if (i.ne.1) s=s+a(i)*x(i-1)
82
if (i.ne.n) s=s+c(i)*x(i+1)
if (abs(s-d(i))<1e-7) then
write (*,*) "stroka", i, "OK"
else
write (*,*) "stroka", i, "is wrong", s, d(i)
end if
end do
end subroutine
end program progonka
program iter_ls
! решение систем линейных алгебраических уравнений методом про-
стой итерации
implicit none
integer, parameter :: N=3 !размер системы
real*8 a(n,n), b(n), x(n), eps, tau, Beta(n,n)
logical pr
integer i,j
eps=0.001 !точность вычислений
a=reshape(source=(/ 3.1, 4.0, 5.0, & !первый столбец матрицы ко-
эффициентов
-1.1, 4.0, 6.0,& !второй столбец
2.0, -2.0, 7.0/),& !третий столбец
shape=(/3,3/)) !форма конечного массива
b=(/3,2,1/) !столбец свободных членов
pr=.true.
x=0 !начальное приближение
tau=0.1
Beta=0
do i=1, n
do j=1, n
if (i.eq.j) Beta(i,j)=1
Beta(i,j)=Beta(i,j)-tau*a(i,j)
end do
end do
do while(pr) ! цикл итераций
call iter()
end do
write (*,*) "x=", x !вывод полученных значений
call proverka() !проверка полученных значений
83
contains
subroutine iter()
implicit none
real*8 xold(N), sum, max
integer i, j
xold=x
max=0.0
do i=1, N
sum=0.0
do j=1, N
sum=sum+beta(i,j)*xold(j)
end do
x(i)=sum+tau*b(i)
if (abs(x(i)-xold(i))>max) max=abs(x(i)-xold(i))
end do
pr=(max>eps)
end subroutine
subroutine proverka() ! проверка полученных значений
implicit none
integer i, j
real*8 s
do i=1, n
s=0.0
do j=1, n
s=s+a(i,j)*x(j)
end do
if (abs(s-b(i))<eps) then
write (*,*) "stroka", i, "OK"
else
write (*,*) "stroka", i, "is wrong", s, b(i)
end if
end do
end subroutine
end
! решение систем линейных алгебраических уравнений методом Гаусса-
Зейделя
program Gauss_zeid
implicit none
84
integer, parameter :: N=3 !размер системы
real*8 a(n,n), b(n), x(n), eps
logical pr
eps=0.000001 !точность вычислений
a=reshape(source=(/ 3.1, 4.0, 5.0, & !первый столбец матрицы ко-
эффициентов
-1.1, 4.0, 6.0,& !второй столбец
2.0, -2.0, 7.0/),& !третий столбец
shape=(/3,3/)) !форма конечного массива
b=(/3,2,1/) !столбец свободных членов
pr=.true.
x=0 !начальное приближение
do while(pr) ! цикл итераций
call iter()
end do
write (*,*) "x=", x !вывод полученных значений
call proverka() !проверка полученных значений
contains
subroutine iter()
implicit none
real*8 xold(N), sum, max
integer i, j
xold=x
max=0.0
do i=1, N
sum=0.0
do j=1, N
if (i.ne.j) sum=sum+a(i,j)*x(j)
end do
x(i)=(b(i)-sum)/(a(i,i))
if (abs(x(i)-xold(i))>max) max=abs(x(i)-xold(i))
end do
pr=(max>eps)
end subroutine
subroutine proverka() ! проверка полученных значений
implicit none
integer i, j
real*8 s
85