Skip to content

Commit 9b8f650

Browse files
committed
In-code documentation.
1 parent fc61941 commit 9b8f650

File tree

1 file changed

+34
-43
lines changed

1 file changed

+34
-43
lines changed

src/stdlib_specialmatrices.fypp

Lines changed: 34 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,10 @@
44
#:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX))
55
#:set KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
66
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))
811
use stdlib_linalg_constants
912
implicit none
1013
private
@@ -19,11 +22,10 @@ module stdlib_specialmatrices
1922
!----- ------
2023
!--------------------------------------
2124

22-
!! Version: experimental
23-
!!
24-
!! Tridiagonal matrix
25+
!--> Tridiagonal matrices
2526
#:for k1, t1, s1 in (KINDS_TYPES)
2627
type, public :: Tridiagonal_${s1}$_type
28+
!! Base type to define a `Tridiagonal` matrix.
2729
private
2830
${t1}$, allocatable :: dl(:), dv(:), du(:)
2931
integer(ilp) :: n
@@ -37,9 +39,9 @@ module stdlib_specialmatrices
3739
!--------------------------------
3840

3941
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.
4345
!!
4446
!! \[
4547
!! A
@@ -104,11 +106,13 @@ module stdlib_specialmatrices
104106
!----- -----
105107
!----------------------------------
106108

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)
111109
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`.
112116
#:for k1, t1, s1 in (KINDS_TYPES)
113117
#:for rank in RANKS
114118
#:if k1 != "qp" and k1 != "xdp"
@@ -131,19 +135,10 @@ module stdlib_specialmatrices
131135
!----- -----
132136
!-------------------------------------
133137

134-
!! Version: experimental
135-
!!
136-
!! Convert a matrix of type `Tridiagonal` to its dense representation.
137-
!! [Specifications](../page/specs/stdlib_specialmatrices.html#dense)
138138
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))
147142
#:for k1, t1, s1 in (KINDS_TYPES)
148143
pure module function tridiagonal_to_dense_${s1}$(A) result(B)
149144
!! Convert a `Tridiagonal` matrix to its dense representation.
@@ -155,11 +150,10 @@ module stdlib_specialmatrices
155150
#:endfor
156151
end interface
157152

158-
!! Version: experimental
159-
!!
160-
!! Returns the transpose of a `Tridiagonal` matrix.
161-
!! [Specifications](../page/specs/stdlib_specialmatrices.html#transpose)
162153
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)
163157
#:for k1, t1, s1 in (KINDS_TYPES)
164158
pure module function transpose_tridiagonal_${s1}$(A) result(B)
165159
type(Tridiagonal_${s1}$_type), intent(in) :: A
@@ -169,11 +163,11 @@ module stdlib_specialmatrices
169163
#:endfor
170164
end interface
171165

172-
!! Version: experimental
173-
!!
174-
!! Returns the Hermitian of a `Tridiagonal` matrix.
175-
!! [Specifications](../page/specs/stdlib_specialmatrices.html#hermitian)
176166
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)
177171
#:for k1, t1, s1 in (KINDS_TYPES)
178172
pure module function hermitian_tridiagonal_${s1}$(A) result(B)
179173
type(Tridiagonal_${s1}$_type), intent(in) :: A
@@ -189,11 +183,10 @@ module stdlib_specialmatrices
189183
!----- -----
190184
!----------------------------------------
191185

192-
!! Version: experimental
193-
!!
194-
!! Overloads the scalar multiplication `*` for `Tridiagonal` matrices.
195-
!! [Specifications](../page/specs/stdlib_specialmatrices.html#operator(*))
196186
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)
197190
#:for k1, t1, s1 in (KINDS_TYPES)
198191
pure module function scalar_multiplication_tridiagonal_${s1}$(alpha, A) result(B)
199192
${t1}$, intent(in) :: alpha
@@ -208,11 +201,10 @@ module stdlib_specialmatrices
208201
#:endfor
209202
end interface
210203

211-
!! Version: experimental
212-
!!
213-
!! Overloads the addition `+` for `Tridiagonal` matrices.
214-
!! [Specifications](../page/specs/stdlib_specialmatrices.html#operator(+))
215204
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)
216208
#:for k1, t1, s1 in (KINDS_TYPES)
217209
pure module function matrix_add_tridiagonal_${s1}$(A, B) result(C)
218210
type(Tridiagonal_${s1}$_type), intent(in) :: A
@@ -222,11 +214,10 @@ module stdlib_specialmatrices
222214
#:endfor
223215
end interface
224216

225-
!! Version: experimental
226-
!!
227-
!! Overloads the subtraction `-` for `Tridiagonal` matrices.
228-
!! [Specifications](../page/specs/stdlib_specialmatrices.html#operator(-))
229217
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)
230221
#:for k1, t1, s1 in (KINDS_TYPES)
231222
pure module function matrix_sub_tridiagonal_${s1}$(A, B) result(C)
232223
type(Tridiagonal_${s1}$_type), intent(in) :: A

0 commit comments

Comments
 (0)