blob: 765e36520c6d7dda0ef80b6f2bd88ad10ed4d57a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
! { dg-do compile }
! Tests the fix for PR55984.
!
! Contributed by Sylwester Arabas <slayoo@staszic.waw.pl>
!
module bcd_m
type, abstract :: bcd_t
contains
procedure(bcd_fill_halos), deferred :: fill_halos
end type
abstract interface
subroutine bcd_fill_halos(this)
import :: bcd_t
class(bcd_t ) :: this
end subroutine
end interface
end module
module solver_m
use bcd_m
type, abstract :: solver_t
integer :: n, hlo
class(bcd_t), pointer :: bcx, bcy
contains
procedure(solver_advop), deferred :: advop
end type
abstract interface
subroutine solver_advop(this)
import solver_t
class(solver_t) :: this
end subroutine
end interface
contains
end module
module solver_mpdata_m
use solver_m
type :: mpdata_t
class(bcd_t), pointer :: bcx, bcy
contains
procedure :: advop => mpdata_advop
end type
contains
subroutine mpdata_advop(this)
class(mpdata_t) :: this
associate ( bcx => this%bcx, bcy => this%bcy )
call bcx%fill_halos()
end associate
end subroutine
end module
use solver_mpdata_m
class(mpdata_t), allocatable :: that
call mpdata_advop (that)
end
|
