!Модуль решения диф уравнения неявным методом Эйлера
module eyler
implicit none
public :: eyler_n
private
contains
!Подпрограмма решения диф. уравнения
subroutine eyler_n(x0, x1, n, y0, y1, error)
real (8), intent (in) :: x0 !Начальное Х
real (8), intent (in) :: x1 !Конечное Х
real (8), intent (in) :: y0 !Начальное Y
real (8), intent (out) :: y1 !Искомое Y
real (8) :: x !Текущее X
real (8) :: y !Текущее Y
real (8) :: h !Шаг интегрирования
integer :: n !Число шагов интегрирования
integer :: i !Счетчик цикла
integer, intent (out) :: error !Сообщение об ошибке
if (n < 30) n = 30
h = (x1-x0) / float(n)
x = x0 + h
y = y0
do i = 1, n
call newton(x, y, h, y, y1, error)
y = y1
x = x + h
if (error == 1) exit
end do
end subroutine eyler_n
!Подпрограмма решения нелинейного уравнения методом Ньютона
subroutine newton (x, y, h, y0, y2, error)
real (8), intent (in) :: x !Текущее Хi+1
real (8), intent (in) :: y !Текущее Yi
real (8), intent (in) :: h !Шаг интегрирования
real (8), intent (in) :: y0 !Начальное приближение для Yi+1
real (8), intent (out) :: y2 !Искомое значение Yi+1
real (8), parameter :: dy = 1.0e-6 !Дифференциал по Y
real (8), parameter :: eps = 1.0e-5 !Необходимая точность
real (8) :: ytemp1, ytemp2 !Временные Y
real (8) :: dg !Производная функции g
integer :: i, error !Счетчик и сообщение о зацикливании
error = 0
ytemp1 = y0
i=0
do while (abs(g(y, h, x, ytemp2)) > eps)
dg = (g(y, h, x, ytemp1+dy) - g(y, h, x, ytemp1-dy)) / (dy+dy)
ytemp2 = y - g(y, h, x, ytemp1) / dg
ytemp1 = ytemp2
i = i + 1
if (i > 10000) then
error = 1
exit
end if
end do
y2 = ytemp2
end subroutine newton
!Пробразованная функция для решения методом Ньютона
pure real (8) function g(y, h, x, y1)
real (8), intent(in) :: y !Текущее Y
real (8), intent(in) :: h !Шаг
real (8), intent(in) :: x !Текущее Х
real (8), intent(in) :: y1 !Подставляемое Y1
!Интерфейс к функции дифференциального уравнения
interface
pure real (8) function f (x, y)
real (8), intent (in) :: x, y
end function f
end interface
g = y + h * f(x, y1) - y1
end function g
end module eyler