1! { dg-do run } 2! 3! PR fortran/51972 4! 5! Contributed by Damian Rouson 6! 7module surrogate_module 8 type ,abstract :: surrogate 9 end type 10end module 11 12module strategy_module 13 use surrogate_module 14 15 type :: strategy 16 end type 17end module 18 19module integrand_module 20 use surrogate_module 21 use strategy_module 22 implicit none 23 24 type ,abstract, extends(surrogate) :: integrand 25 class(strategy), allocatable :: quadrature 26 end type 27end module integrand_module 28 29module lorenz_module 30 use strategy_module 31 use integrand_module 32 implicit none 33 34 type ,extends(integrand) :: lorenz 35 real, dimension(:), allocatable :: state 36 contains 37 procedure ,public :: assign => assign_lorenz 38 end type 39contains 40 type(lorenz) function constructor(initial_state, this_strategy) 41 real ,dimension(:) ,intent(in) :: initial_state 42 class(strategy) ,intent(in) :: this_strategy 43 constructor%state=initial_state 44 allocate (constructor%quadrature, source=this_strategy) 45 end function 46 47 subroutine assign_lorenz(lhs,rhs) 48 class(lorenz) ,intent(inout) :: lhs 49 class(integrand) ,intent(in) :: rhs 50 select type(rhs) 51 class is (lorenz) 52 allocate (lhs%quadrature, source=rhs%quadrature) 53 lhs%state=rhs%state 54 end select 55 end subroutine 56end module lorenz_module 57 58module runge_kutta_2nd_module 59 use surrogate_module,only : surrogate 60 use strategy_module ,only : strategy 61 use integrand_module,only : integrand 62 implicit none 63 64 type, extends(strategy) ,public :: runge_kutta_2nd 65 contains 66 procedure, nopass :: integrate 67 end type 68contains 69 subroutine integrate(this) 70 class(surrogate) ,intent(inout) :: this 71 class(integrand) ,allocatable :: this_half 72 73 select type (this) 74 class is (integrand) 75 allocate (this_half, source=this) 76 end select 77 end subroutine 78end module 79 80program main 81 use lorenz_module 82 use runge_kutta_2nd_module ,only : runge_kutta_2nd, integrate 83 implicit none 84 85 type(runge_kutta_2nd) :: timed_lorenz_integrator 86 type(lorenz) :: attractor 87 88 attractor = constructor( [1., 1., 1.] , timed_lorenz_integrator) 89 call integrate(attractor) 90end program main 91