1! { dg-do compile }
2!
3! PR fortran/48889
4!
5! Thanks for
6! reporting to Lawrence Mitchell
7! for the test case to David Ham
8!
9module sparse_tools
10  implicit none
11  private
12
13  type csr_foo
14     integer, dimension(:), pointer :: colm=>null()
15  end type csr_foo
16
17  type block_csr_matrix
18     type(csr_foo) :: sparsity
19  end type block_csr_matrix
20
21  interface attach_block
22     module procedure block_csr_attach_block
23  end interface
24
25  interface size
26     module procedure  sparsity_size
27  end interface
28
29  public :: size, attach_block
30contains
31  subroutine block_csr_attach_block(matrix, val)
32    type(block_csr_matrix), intent(inout) :: matrix
33    real, dimension(size(matrix%sparsity%colm)), intent(in), target :: val
34  end subroutine block_csr_attach_block
35
36  pure function sparsity_size(sparsity, dim)
37    integer :: sparsity_size
38    type(csr_foo), intent(in) :: sparsity
39    integer, optional, intent(in) :: dim
40  end function sparsity_size
41end module sparse_tools
42
43module global_numbering
44  use sparse_tools
45  implicit none
46
47  type ele_numbering_type
48     integer :: boundaries
49  end type ele_numbering_type
50
51  type element_type
52     integer :: loc
53     type(ele_numbering_type), pointer :: numbering=>null()
54  end type element_type
55
56  type csr_sparsity
57  end type csr_sparsity
58
59  interface size
60     module procedure sparsity_size
61  end interface size
62contains
63  pure function sparsity_size(sparsity, dim)
64    integer :: sparsity_size
65    type(csr_sparsity), intent(in) :: sparsity
66    integer, optional, intent(in) :: dim
67  end function sparsity_size
68
69  subroutine make_boundary_numbering(EEList, xndglno, ele_n)
70    type(csr_sparsity), intent(in) :: EEList
71    type(element_type), intent(in) :: ele_n
72    integer, dimension(size(EEList,1)*ele_n%loc), intent(in), target ::&
73         & xndglno
74    integer, dimension(ele_n%numbering%boundaries) :: neigh
75    integer :: j
76    j=size(neigh)
77  end subroutine make_boundary_numbering
78end module global_numbering
79
80module sparse_matrices_fields
81  use sparse_tools
82implicit none
83   type scalar_field
84      real, dimension(:), pointer :: val
85   end type scalar_field
86contains
87  subroutine csr_mult_T_scalar(x)
88    type(scalar_field), intent(inout) :: x
89    real, dimension(:), allocatable :: tmp
90    integer :: i
91    i=size(x%val)
92  end subroutine csr_mult_T_scalar
93end module sparse_matrices_fields
94
95program test
96  use sparse_matrices_fields
97  use global_numbering
98end program test
99