我正在尝试实现一个用于在Fortran 2003中集成ODE的框架。这个想法是要有一个抽象类odeType和一些用于时间集成,I / O等的子例程。然后,将在派生的对象中实现特定的ODE。从基本odeType开始。下面的示例在Linux上使用ifortran编译器进行编译时会产生错误:
error #8169: The specified interface is not declared. [MSDDDERIVS_]
procedure :: derivs => msdDderivs_
但是,除了已经为derivs_ode实现的抽象接口之外,我似乎无法为此方法声明一个单独的接口。如果有人知道出了什么问题,我非常欢迎您的输入!
module eomModule
implicit none
integer, parameter :: nDof=2
! ==========================
! ODE BASE CLASS DECLARATION
! ==========================
type, abstract :: odeType
! --- properties ---
! --- member function declarations ---
contains
! calculation of the derivative vector
! NOTE: in C++ this would be a pure virtual function, redefine in each
! extended object to implement required dynamics.
procedure(derivs_ode), deferred :: derivs
end type odeType
! define an interface for the abstract method to allow inheritance and overloading
! in derived types.
abstract interface
subroutine derivs_ode(this, yDotNew, y, x)
! need to import custom type definitions from the outside scope
import odeType, nDof
! declare arguments for the derived functions
class(odeType), intent(in) :: this
real*16, dimension(nDof*2), intent(out) :: yDotNew
real*16, dimension(nDof*2), intent(in) :: y
real*16, intent(in) :: x
end subroutine
end interface
! ==========================
! MSD CLASS DECLARATION
! ==========================
type, extends(odeType) :: msdType
! --- properties ---
real*16, dimension(nDof,nDof) :: m, k, c
real*16, dimension(nDof) :: F, omega
! --- member function declarations ---
contains
! calculation of the derivative vector
**!!!! PROBLEMS HERE !!!!!**
procedure :: derivs => msdDderivs_
end type msdType
contains
!>
!! Computes derivatives of the state vector of a 2D mass-spring-damper system
!<
!=====================================================================
subroutine msdDerivs_(this, yDotNew, y, x)
!=====================================================================
class(odeType), intent(in) :: this
real*16, dimension(nDof*2), intent(out) :: yDotNew
real*16, dimension(nDof*2), intent(in) :: y
real*16, intent(in) :: x
real*16, dimension(nDof,nDof) :: mInv
real*16, dimension(nDof) :: effK, effC, effF
integer :: i
! DO CALCULATIONS HERE
! return the updated derivative of the state vector
yDotNew = (/0., 0., 0., 0./)
end subroutine msdDerivs_
end module eomModule
! =====================
program integrationTest
use eomModule
implicit none
! =====================
! --- define all program variables ---
real*16, dimension(nDof*2) :: y0
real*16 :: dt=1e-3, tEnd=10.0, t=0.
real*16, parameter :: PI=3.1415926359
type(msdType) :: msdOde
! --- populate system constants ---
msdOde%m(1,:) = (/0.2, 0.0/)
msdOde%m(2,:) = (/0.0, 0.2/)
msdOde%k(1,:) = (/5.0, 0.0/)
msdOde%k(2,:) = (/0.0, 9.0/)
msdOde%c(1,:) = (/0.2, 0.0/)
msdOde%c(2,:) = (/0.0, 0.3/)
msdOde%F = (/1.0, 1.0/)
msdOde%omega = (/2.*PI*1., 2.*PI*2./)
y0 = (/0.2, 0.2, 0.0, 0.0/)
! --- do stuff ---
call odeIntEuler(msdOde, t, tEnd, dt, y0)
! =====================
contains
!>
!! Performs simple Euler time integration with a fixed time step.
!<
!=====================================================================
subroutine odeIntEuler(ode, t, tEnd, dt, y0)
!=====================================================================
type(odeType), intent(in) :: ode
real*16, intent(in) :: tEnd, dt
real*16, intent(inout) :: t
real*16, dimension(nDof*2), intent(in) :: y0
real*16, dimension(nDof*2) :: y, yDot
y = y0
print *, "time,y0,y1,ydot0,ydot1,yddot0,yddot1"
do while (t<tEnd)
call ode%derivs(yDot, y, t)
print "(1x,f0.6,6(',',f0.6))", t, y(1), y(2), y(3), y(4), yDot(3), yDot(4)
y = y + yDot*dt
t = t+dt
enddo
end subroutine odeIntEuler
end program integrationTest