Subversion Repositories openrisc

! { dg-do run }

!

! PR fortran/51972

!

! Contributed by Damian Rouson

!

module surrogate_module

  type ,abstract :: surrogate

  end type

end module

module strategy_module

  use surrogate_module

  type :: strategy

  end type

end module

module integrand_module

  use surrogate_module

  use strategy_module

  implicit none

  type ,abstract, extends(surrogate) :: integrand

    class(strategy), allocatable :: quadrature

  end type

end module integrand_module

module lorenz_module

  use strategy_module

  use integrand_module

  implicit none

  type ,extends(integrand) :: lorenz

    real, dimension(:), allocatable :: state

  contains

    procedure ,public :: assign   => assign_lorenz

  end type

contains

  type(lorenz) function constructor(initial_state, this_strategy)

    real ,dimension(:) ,intent(in)  :: initial_state

    class(strategy)    ,intent(in)  :: this_strategy

    constructor%state=initial_state

    allocate (constructor%quadrature, source=this_strategy)

  end function

  subroutine assign_lorenz(lhs,rhs)

    class(lorenz)    ,intent(inout) :: lhs

    class(integrand) ,intent(in)    :: rhs

    select type(rhs)

      class is (lorenz)

        allocate (lhs%quadrature, source=rhs%quadrature)

        lhs%state=rhs%state

    end select

  end subroutine

end module lorenz_module

module runge_kutta_2nd_module

  use surrogate_module,only : surrogate

  use strategy_module ,only : strategy

  use integrand_module,only : integrand

  implicit none

  type, extends(strategy) ,public :: runge_kutta_2nd

  contains

    procedure, nopass :: integrate

  end type

contains

  subroutine integrate(this)

    class(surrogate) ,intent(inout) :: this

    class(integrand) ,allocatable   :: this_half

    select type (this)

      class is (integrand)

        allocate (this_half, source=this)

    end select

  end subroutine

end module

program main

  use lorenz_module

  use runge_kutta_2nd_module ,only : runge_kutta_2nd, integrate

  implicit none

  type(runge_kutta_2nd) :: timed_lorenz_integrator

  type(lorenz)          :: attractor

  attractor = constructor( [1., 1., 1.] , timed_lorenz_integrator)

  call integrate(attractor)

end program main

! { dg-final { cleanup-modules "surrogate_module strategy_module integrand_module runge_kutta_2nd_module" } }