现代 Fortran 中二阶微分方程的通用 runge-kutta 函数

General purpose runge-kutta function for second order differential equations in Modern Fortran

如何创建一个函数 func2(func1,t,y0),它接收另一个函数 func1 作为参数,但其中 func1 是一个 return 是一维实数 (kind=8)、维数 ( :) 数组?

我有以下用 Matlab 编写的代码,为了速度和可移植性,我想用现代 Fortran 编写一个等效代码。我已经为一阶微分方程写了一个,但我正在努力为二阶和更高阶微分方程编写代码,因为对应于微分方程的外部变量必须 return 一个维度数组(:)。我想要一个通用的代码,即我想要一个可以传递任何微分方程的函数或子程序。

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

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

如果一个函数 returns 一个数组,它的接口必须在调用者中是显式的。对于伪参数函数,实现此目的的最简单方法是使用 PROCEDURE 语句从可用作实际参数的函数中克隆接口。从您的代码开始,翻译成 Fortran 并添加声明,我们得到:

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 程序绘制的结果相同。