Функция Рунге-Кутта общего назначения для дифференциальных уравнений второго порядка в современном Фортране

Question

Как сделать функцию func2 (func1, t, y0), которая получает другую функцию func1 в качестве аргумента, но где func1 - это функция, которая возвращает 1-мерное действительное (kind = 8), измерение (:) массив?

У меня есть следующий код, написанный на Matlab, и я хотел бы написать эквивалентный код на Modern Fortran для скорости и переносимости. Я написал один для дифференциальных уравнений первого порядка, но я борюсь с задачей написания кода для кода для дифференциальных уравнений второго и более высоких порядков, потому что внешняя переменная, соответствующая дифференциальным уравнениям, должна возвращать массив с размерностью (:). Я хочу, чтобы код был общего назначения, т. Е. Я хочу функцию или подпрограмму, в которую я могу передать любое дифференциальное уравнение.

Код MatLab:

% ---------------------------------------------- -----------------------------

clear all
close all
clc

t = [0:0.01:20]';
y0 = [2, 0]';

y = func_runge_kutta(@func_my_ode,t,y0);

function dy=func_my_ode(t,y)
    % Second order differential equation y'' - (1-y^2)*y'+y = 0
    dy = zeros(size(y));
    dy(1) = y(2);
    dy(2) = (1-y(1)^2)*y(2)-y(1);
end

function y = func_runge_kutta(func_my_ode,t,y0)
    y = zeros(length(t),length(y0));
    y(1,:) = y0';
    for i=1:(length(t)-1)
        h = t(i+1)-t(i);
        F_1 = func_my_ode(t(i),y(i,:)');
        F_2 = func_my_ode(t(i)+h/2,y(i,:)'+h/2*F_1);
        F_3 = func_my_ode(t(i)+h/2,y(i,:)'+h/2*F_2);
        F_4 = func_my_ode(t(i)+h,y(i,:)'+h*F_3);
        y(i+1,:) = y(i,:)+h/6*(F_1+2*F_2+2*F_3+F_4)';
    end
end

% ---------------------------------------------- -----------------------------

Answer 1

Если функция возвращает массив, ее интерфейс должен быть явным в вызывающей программе. Самый простой способ добиться этого для фиктивной функции аргумента - использовать инструкцию PROCEDURE для клонирования интерфейса из функции, которая может использоваться в качестве фактического аргумента. Начиная с вашего кода, переводя на Фортран и добавляя объявления, мы получаем:

module everything
   use ISO_FORTRAN_ENV, only : wp => REAL64
   implicit none
   contains
function func_my_ode_1(t,y) result(dy)
    ! Second order differential equation y'' - (1-y**2)*y'+y = 0
real(wp) t
real(wp) y(:)
real(wp) dy(size(y))
    dy(1) = y(2);
    dy(2) = (1-y(1)**2)*y(2)-y(1);
end

function func_runge_kutta(func_my_ode,t,y0) result(y)
   procedure(func_my_ode_1) func_my_ode
   real(wp) t(:)
   real(wp) y0(:)
   real(wp) y(size(t),size(y0))
   integer i
   real(wp) h
   real(wp) F_1(size(y0)),F_2(size(y0)),F_3(size(y0)),F_4(size(y0))
    y(1,:) = y0;
    do i=1,(size(t)-1)
        h = t(i+1)-t(i);
        F_1 = func_my_ode(t(i),y(i,:));
        F_2 = func_my_ode(t(i)+h/2,y(i,:)+h/2*F_1);
        F_3 = func_my_ode(t(i)+h/2,y(i,:)+h/2*F_2);
        F_4 = func_my_ode(t(i)+h,y(i,:)+h*F_3);
        y(i+1,:) = y(i,:)+h/6*(F_1+2*F_2+2*F_3+F_4);
    end do
end
end module everything

program main
!clear all
!close all
!clc
use everything
implicit none
real(wp), allocatable :: t(:)
real(wp), allocatable :: y0(:)
real(wp), allocatable :: y(:,:)
integer i
integer iunit

t = [(0+0.01_wp*i,i=0,nint(20/0.01_wp))];
y0 = [2, 0];

y = func_runge_kutta(func_my_ode_1,t,y0);
open(newunit=iunit,file='rk4.txt',status='replace')
do i = 1,size(t)
   write(iunit,*) t(i),y(i,1)
end do
end program main

Я сделал, чтобы Matlab прочитал файл данных, и он нарисовал ту же картинку, что и оригинальная программа Matlab, если бы он нанес свои результаты.