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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
! { dg-do compile }
!
! PR fortran/48889
!
! Thanks for
! reporting to Lawrence Mitchell
! for the test case to David Ham
!
module sparse_tools
implicit none
private
type csr_foo
integer, dimension(:), pointer :: colm=>null()
end type csr_foo
type block_csr_matrix
type(csr_foo) :: sparsity
end type block_csr_matrix
interface attach_block
module procedure block_csr_attach_block
end interface
interface size
module procedure sparsity_size
end interface
public :: size, attach_block
contains
subroutine block_csr_attach_block(matrix, val)
type(block_csr_matrix), intent(inout) :: matrix
real, dimension(size(matrix%sparsity%colm)), intent(in), target :: val
end subroutine block_csr_attach_block
pure function sparsity_size(sparsity, dim)
integer :: sparsity_size
type(csr_foo), intent(in) :: sparsity
integer, optional, intent(in) :: dim
end function sparsity_size
end module sparse_tools
module global_numbering
use sparse_tools
implicit none
type ele_numbering_type
integer :: boundaries
end type ele_numbering_type
type element_type
integer :: loc
type(ele_numbering_type), pointer :: numbering=>null()
end type element_type
type csr_sparsity
end type csr_sparsity
interface size
module procedure sparsity_size
end interface size
contains
pure function sparsity_size(sparsity, dim)
integer :: sparsity_size
type(csr_sparsity), intent(in) :: sparsity
integer, optional, intent(in) :: dim
end function sparsity_size
subroutine make_boundary_numbering(EEList, xndglno, ele_n)
type(csr_sparsity), intent(in) :: EEList
type(element_type), intent(in) :: ele_n
integer, dimension(size(EEList,1)*ele_n%loc), intent(in), target ::&
& xndglno
integer, dimension(ele_n%numbering%boundaries) :: neigh
integer :: j
j=size(neigh)
end subroutine make_boundary_numbering
end module global_numbering
module sparse_matrices_fields
use sparse_tools
implicit none
type scalar_field
real, dimension(:), pointer :: val
end type scalar_field
contains
subroutine csr_mult_T_scalar(x)
type(scalar_field), intent(inout) :: x
real, dimension(:), allocatable :: tmp
integer :: i
i=size(x%val)
end subroutine csr_mult_T_scalar
end module sparse_matrices_fields
program test
use sparse_matrices_fields
use global_numbering
end program test
|
