1! { dg-do compile } 2module m1 3 implicit none 4 5 type, abstract :: vector_class 6 end type vector_class 7end module m1 8!--------------------------------------------------------------- 9module m2 10 use m1 11 implicit none 12 13 type, abstract :: inner_product_class 14 contains 15 procedure(dot), deferred :: dot_v_v 16 procedure(dot), deferred :: dot_g_g 17 procedure(sub), deferred :: D_times_v 18 procedure(sub), deferred :: D_times_g 19 end type inner_product_class 20 21 abstract interface 22 function dot (this,a,b) 23 import :: inner_product_class 24 import :: vector_class 25 class(inner_product_class), intent(in) :: this 26 class(vector_class), intent(in) :: a,b 27 real :: dot 28 end function 29 subroutine sub (this,a) 30 import :: inner_product_class 31 import :: vector_class 32 class(inner_product_class), intent(in) :: this 33 class(vector_class), intent(inout) :: a 34 end subroutine 35 end interface 36end module m2 37!--------------------------------------------------------------- 38module m3 39 use :: m1 40 use :: m2 41 implicit none 42 private 43 public :: gradient_class 44 45 type, abstract, extends(vector_class) :: gradient_class 46 class(inner_product_class), pointer :: my_inner_product => NULL() 47 contains 48 procedure, non_overridable :: inquire_inner_product 49 procedure(op_g_v), deferred :: to_vector 50 end type gradient_class 51 52 abstract interface 53 subroutine op_g_v(this,v) 54 import vector_class 55 import gradient_class 56 class(gradient_class), intent(in) :: this 57 class(vector_class), intent(inout) :: v 58 end subroutine 59 end interface 60contains 61 function inquire_inner_product (this) 62 class(gradient_class) :: this 63 class(inner_product_class), pointer :: inquire_inner_product 64 65 inquire_inner_product => this%my_inner_product 66 end function inquire_inner_product 67end module m3 68!--------------------------------------------------------------- 69module m4 70 use m3 71 use m2 72 implicit none 73contains 74 subroutine cg (g_initial) 75 class(gradient_class), intent(in) :: g_initial 76 77 class(inner_product_class), pointer :: ip_save 78 ip_save => g_initial%inquire_inner_product() 79 end subroutine cg 80end module m4 81