4
4
#:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX))
5
5
#:set KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
6
6
module stdlib_specialmatrices
7
- use ieee_arithmetic
7
+ !! Provides derived-types and associated specialized linear algebra drivers
8
+ !! for highly-structured matrices commonly encountered in the discretization
9
+ !! of partial differential equations, as well as control and signal processing
10
+ !! applications. ([Specifications]](../page/specs/stdlib_specialmatrices.html))
8
11
use stdlib_linalg_constants
9
12
implicit none
10
13
private
@@ -19,11 +22,10 @@ module stdlib_specialmatrices
19
22
!----- ------
20
23
!--------------------------------------
21
24
22
- !! Version: experimental
23
- !!
24
- !! Tridiagonal matrix
25
+ !--> Tridiagonal matrices
25
26
#:for k1, t1, s1 in (KINDS_TYPES)
26
27
type, public :: Tridiagonal_${s1}$_type
28
+ !! Base type to define a `Tridiagonal` matrix.
27
29
private
28
30
${t1}$, allocatable :: dl(:), dv(:), du(:)
29
31
integer(ilp) :: n
@@ -37,9 +39,9 @@ module stdlib_specialmatrices
37
39
!--------------------------------
38
40
39
41
interface Tridiagonal
40
- !! This interface provides different methods to construct a
41
- !! `Tridiagonal` matrix. Only the non-zero elements of \( A \) are
42
- !! stored, i.e.
42
+ !! ([Specifications](../page/specs/stdlib_specialmatrices.html#Tridiagonal)) This
43
+ !! interface provides different methods to construct a `Tridiagonal` matrix. Only
44
+ !! the non-zero elements of \( A \) are stored, i.e.
43
45
!!
44
46
!! \[
45
47
!! A
@@ -104,11 +106,13 @@ module stdlib_specialmatrices
104
106
!----- -----
105
107
!----------------------------------
106
108
107
- !! Version: experimental
108
- !!
109
- !! Apply the matrix-vector product $$y = \alpha * op(M) * x + \beta * y $$
110
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#spmv)
111
109
interface spmv
110
+ !! ([Specifications](../page/specs/stdlib_specialmatrices.html#spmv)) This
111
+ !! interface provides methods to compute the matrix-vector product
112
+ !!
113
+ !! $$ y = \alpha \mathrm{op}(A) x + \beta y$$
114
+ !!
115
+ !! for the different matrix types defined by `stdlib_specialmatrices`.
112
116
#:for k1, t1, s1 in (KINDS_TYPES)
113
117
#:for rank in RANKS
114
118
#:if k1 != "qp" and k1 != "xdp"
@@ -131,19 +135,10 @@ module stdlib_specialmatrices
131
135
!----- -----
132
136
!-------------------------------------
133
137
134
- !! Version: experimental
135
- !!
136
- !! Convert a matrix of type `Tridiagonal` to its dense representation.
137
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#dense)
138
138
interface dense
139
- !! This interface provides methods to convert a `Tridiagonal` matrix
140
- !! to a regular rank-2 array.
141
- !!
142
- !! #### Syntax
143
- !!
144
- !! ```fortran
145
- !! B = dense(A)
146
- !! ```
139
+ !! This interface provides methods to convert a matrix of one of the
140
+ !! types defined by `stdlib_specialmatrices` to a standard rank-2 array.
141
+ !! ([Specifications](../page/specs/stdlib_specialmatrices.html#dense))
147
142
#:for k1, t1, s1 in (KINDS_TYPES)
148
143
pure module function tridiagonal_to_dense_${s1}$(A) result(B)
149
144
!! Convert a `Tridiagonal` matrix to its dense representation.
@@ -155,11 +150,10 @@ module stdlib_specialmatrices
155
150
#:endfor
156
151
end interface
157
152
158
- !! Version: experimental
159
- !!
160
- !! Returns the transpose of a `Tridiagonal` matrix.
161
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#transpose)
162
153
interface transpose
154
+ !! This interface provides methods to compute the transpose operation for
155
+ !! the different matrix types defined by `stdlib_specialmatrices`.
156
+ !! [Specifications](../page/specs/stdlib_specialmatrices.html#transpose)
163
157
#:for k1, t1, s1 in (KINDS_TYPES)
164
158
pure module function transpose_tridiagonal_${s1}$(A) result(B)
165
159
type(Tridiagonal_${s1}$_type), intent(in) :: A
@@ -169,11 +163,11 @@ module stdlib_specialmatrices
169
163
#:endfor
170
164
end interface
171
165
172
- !! Version: experimental
173
- !!
174
- !! Returns the Hermitian of a `Tridiagonal` matrix.
175
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#hermitian)
176
166
interface hermitian
167
+ !! This interface provides methods to compute the hermitian operation for
168
+ !! the different matrix types defined by `stdlib_specialmatrices`. For
169
+ !! real-valued matrices, this is equivalent to the standard `transpose`.
170
+ !! [Specifications](../page/specs/stdlib_specialmatrices.html#hermitian)
177
171
#:for k1, t1, s1 in (KINDS_TYPES)
178
172
pure module function hermitian_tridiagonal_${s1}$(A) result(B)
179
173
type(Tridiagonal_${s1}$_type), intent(in) :: A
@@ -189,11 +183,10 @@ module stdlib_specialmatrices
189
183
!----- -----
190
184
!----------------------------------------
191
185
192
- !! Version: experimental
193
- !!
194
- !! Overloads the scalar multiplication `*` for `Tridiagonal` matrices.
195
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#operator(*))
196
186
interface operator(*)
187
+ !! Overload the `*` for scalar-matrix multiplications for the different matrix
188
+ !! types provided by `stdlib_specialmatrices`.
189
+ !! [Specifications](../page/specs/stdlib_specialmatrices.html#operators)
197
190
#:for k1, t1, s1 in (KINDS_TYPES)
198
191
pure module function scalar_multiplication_tridiagonal_${s1}$(alpha, A) result(B)
199
192
${t1}$, intent(in) :: alpha
@@ -208,11 +201,10 @@ module stdlib_specialmatrices
208
201
#:endfor
209
202
end interface
210
203
211
- !! Version: experimental
212
- !!
213
- !! Overloads the addition `+` for `Tridiagonal` matrices.
214
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#operator(+))
215
204
interface operator(+)
205
+ !! Overload the `+` operator for matrix-matrix addition. The two matrices need to
206
+ !! be of the same type and kind.
207
+ !! [Specifications](../page/specs/stdlib_specialmatrices.html#operators)
216
208
#:for k1, t1, s1 in (KINDS_TYPES)
217
209
pure module function matrix_add_tridiagonal_${s1}$(A, B) result(C)
218
210
type(Tridiagonal_${s1}$_type), intent(in) :: A
@@ -222,11 +214,10 @@ module stdlib_specialmatrices
222
214
#:endfor
223
215
end interface
224
216
225
- !! Version: experimental
226
- !!
227
- !! Overloads the subtraction `-` for `Tridiagonal` matrices.
228
- !! [Specifications](../page/specs/stdlib_specialmatrices.html#operator(-))
229
217
interface operator(-)
218
+ !! Overload the `-` operator for matrix-matrix subtraction. The two matrices need to
219
+ !! be of the same type and kind.
220
+ !! [Specifications](../page/specs/stdlib_specialmatrices.html#operators)
230
221
#:for k1, t1, s1 in (KINDS_TYPES)
231
222
pure module function matrix_sub_tridiagonal_${s1}$(A, B) result(C)
232
223
type(Tridiagonal_${s1}$_type), intent(in) :: A
0 commit comments