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

Question

How to make a function func2(func1,t,y0) which receives another function func1 as an argument, but where func1 is a function that returns a 1D real(kind=8), dimension(:) array?

I have the following code written in Matlab, and I would like to write an equivalent one in Modern Fortran for speed and portability. I have written one for first order differential equations, but I'm struggling with the task of writing the code for a code for second and higher order differential equations because the external variable corresponding to differential equations must return an array with dimension(:). I want a code to be general purpose, i.e. I want a function or subroutine to which I can pass any differential equation.

The MatLab code is:

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

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

If a function returns an array its interface must be explicit in the caller. The easiest way to achieve this for a dummy argument function is to use the PROCEDURE statement to clone the interface from a function that may be used as an actual argument. Starting with your code, translating to Fortran and adding declarations, we get:

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

I had Matlab read the data file and it plotted the same picture as the original Matlab program would have, had it plotted its results.