Skip to content

Commit 1773de8

Browse files
authored
Merge branch 'master' into least_squares
2 parents dafa081 + 28ae6e0 commit 1773de8

12 files changed

+781
-72
lines changed

doc/specs/stdlib_hashmaps.md

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -157,11 +157,13 @@ Procedures to manipulate `key_type` data:
157157
`key_in`, to contents of the key, `key_out`.
158158

159159
* `get( key, value )` - extracts the contents of `key` into `value`,
160-
an `int8` array or character string.
160+
an `int8` array, 'int32' array, or character string.
161161

162162
* `free_key( key )` - frees the memory in `key`.
163163

164-
* `set( key, value )` - sets the content of `key` to `value`.
164+
* `set( key, value )` - sets the content of `key` to `value`.
165+
Supported key types are `int8` array, `int32` array, and character
166+
string.
165167

166168
Procedures to manipulate `other_type` data:
167169

@@ -474,9 +476,9 @@ is an `intent(in)` argument.
474476

475477
`value`: if the the first argument is of `key_type` `value` shall be
476478
an allocatable default character string variable, or
477-
an allocatable vector variable of type integer and kind `int8`,
478-
otherwise the first argument is of `other_type` and `value` shall be
479-
an allocatable of `class(*)`. It is an `intent(out)` argument.
479+
an allocatable vector variable of type integer and kind `int8` or
480+
`int32`, otherwise the first argument is of `other_type` and `value`
481+
shall be an allocatable of `class(*)`. It is an `intent(out)` argument.
480482

481483
##### Example
482484

@@ -751,13 +753,14 @@ is an `intent(out)` argument.
751753

752754
`value`: if the first argument is `key` `value` shall be a default
753755
character string scalar expression, or a vector expression of type integer
754-
and kind `int8`, while for a first argument of type `other` `value`
755-
shall be of type `class(*)`. It is an `intent(in)` argument.
756+
and kind `int8` or `int32`, while for a first argument of type
757+
`other` `value` shall be of type `class(*)`. It is an `intent(in)`
758+
argument.
756759

757760
##### Note
758761

759-
Values of types other than a scalar default character or an
760-
`int8` vector can be used as the basis of a `key` by transferring the
762+
Values of types other than a scalar default character or and
763+
`int8` or `int32` vector can be used as the basis of a `key` by transferring the
761764
value to an `int8` vector.
762765

763766
##### Example

doc/specs/stdlib_linalg.md

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -643,3 +643,77 @@ Exceptions trigger an `error stop`.
643643
```fortran
644644
{!example/linalg/example_lstsq.f90!}
645645
```
646+
647+
## `det` - Computes the determinant of a square matrix
648+
649+
### Status
650+
651+
Experimental
652+
653+
### Description
654+
655+
This function computes the determinant of a `real` or `complex` square matrix.
656+
657+
This interface comes with a `pure` version `det(a)`, and a non-pure version `det(a,overwrite_a,err)` that
658+
allows for more expert control.
659+
660+
### Syntax
661+
662+
`c = ` [[stdlib_linalg(module):det(interface)]] `(a [, overwrite_a, err])`
663+
664+
### Arguments
665+
666+
`a`: Shall be a rank-2 square array
667+
668+
`overwrite_a` (optional): Shall be an input `logical` flag. if `.true.`, input matrix `a` will be used as temporary storage and overwritten. This avoids internal data allocation.
669+
This is an `intent(in)` argument.
670+
671+
`err` (optional): Shall be a `type(linalg_state_type)` value. This is an `intent(out)` argument.
672+
673+
### Return value
674+
675+
Returns a `real` scalar value of the same kind of `a` that represents the determinant of the matrix.
676+
677+
Raises `LINALG_ERROR` if the matrix is singular.
678+
Raises `LINALG_VALUE_ERROR` if the matrix is non-square.
679+
Exceptions are returned to the `err` argument if provided; an `error stop` is triggered otherwise.
680+
681+
### Example
682+
683+
```fortran
684+
{!example/linalg/example_determinant.f90!}
685+
```
686+
687+
## `.det.` - Determinant operator of a square matrix
688+
689+
### Status
690+
691+
Experimental
692+
693+
### Description
694+
695+
This operator returns the determinant of a real square matrix.
696+
697+
This interface is equivalent to the `pure` version of determinant [[stdlib_linalg(module):det(interface)]].
698+
699+
### Syntax
700+
701+
`c = ` [[stdlib_linalg(module):operator(.det.)(interface)]] `(a)`
702+
703+
### Arguments
704+
705+
`a`: Shall be a rank-2 square array of any `real` or `complex` kinds. It is an `intent(in)` argument.
706+
707+
### Return value
708+
709+
Returns a real scalar value that represents the determinnt of the matrix.
710+
711+
Raises `LINALG_ERROR` if the matrix is singular.
712+
Raises `LINALG_VALUE_ERROR` if the matrix is non-square.
713+
Exceptions trigger an `error stop`.
714+
715+
### Example
716+
717+
```fortran
718+
{!example/linalg/example_determinant2.f90!}
719+
```

example/linalg/CMakeLists.txt

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,3 +19,5 @@ ADD_EXAMPLE(state2)
1919
ADD_EXAMPLE(blas_gemv)
2020
ADD_EXAMPLE(lapack_getrf)
2121
ADD_EXAMPLE(lstsq)
22+
ADD_EXAMPLE(determinant)
23+
ADD_EXAMPLE(determinant2)
Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
program example_determinant
2+
use stdlib_kinds, only: dp
3+
use stdlib_linalg, only: det, linalg_state_type
4+
implicit none
5+
type(linalg_state_type) :: err
6+
7+
real(dp) :: d
8+
9+
! Compute determinate of a real matrix
10+
d = det(reshape([real(dp)::1,2,3,4],[2,2]))
11+
12+
print *, d ! a*d-b*c = -2.0
13+
14+
end program example_determinant
Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
program example_determinant2
2+
use stdlib_kinds, only: dp
3+
use stdlib_linalg, only: operator(.det.)
4+
implicit none
5+
6+
real(dp) :: d
7+
8+
! Compute determinate of a real matrix
9+
d = .det.reshape([real(dp)::1,2,3,4],[2,2])
10+
11+
print *, d ! a*d-b*c = -2.0
12+
13+
end program example_determinant2

src/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ set(fppFiles
2525
stdlib_linalg_outer_product.fypp
2626
stdlib_linalg_kronecker.fypp
2727
stdlib_linalg_cross_product.fypp
28+
stdlib_linalg_determinant.fypp
2829
stdlib_linalg_state.fypp
2930
stdlib_optval.fypp
3031
stdlib_selection.fypp

src/stdlib_hashmap_wrappers.f90

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,7 @@ end function hasher_fun
8888

8989
module procedure get_char_key, &
9090
get_int8_key, &
91+
get_int32_key, &
9192
get_other
9293

9394
end interface get
@@ -101,6 +102,7 @@ end function hasher_fun
101102

102103
module procedure set_char_key, &
103104
set_int8_key, &
105+
set_int32_key, &
104106
set_other
105107

106108
end interface set
@@ -277,6 +279,21 @@ subroutine get_int8_key( key, value )
277279
end subroutine get_int8_key
278280

279281

282+
pure subroutine get_int32_key( key, value )
283+
!! Version: Experimental
284+
!!
285+
!! Gets the contents of the key as an INTEGER(INT32) vector
286+
!! Arguments:
287+
!! key - the input key
288+
!! value - the contents of key mapped to an INTEGER(INT32) vector
289+
type(key_type), intent(in) :: key
290+
integer(int32), allocatable, intent(out) :: value(:)
291+
292+
value = transfer( key % value, value )
293+
294+
end subroutine get_int32_key
295+
296+
280297
subroutine set_char_key( key, value )
281298
!! Version: Experimental
282299
!!
@@ -323,6 +340,21 @@ subroutine set_int8_key( key, value )
323340
end subroutine set_int8_key
324341

325342

343+
pure subroutine set_int32_key( key, value )
344+
!! Version: Experimental
345+
!!
346+
!! Sets the contents of the key from an INTEGER(INT32) vector
347+
!! Arguments:
348+
!! key - the output key
349+
!! value - the input INTEGER(INT32) vector
350+
type(key_type), intent(out) :: key
351+
integer(int32), intent(in) :: value(:)
352+
353+
key % value = transfer(value, key % value)
354+
355+
end subroutine set_int32_key
356+
357+
326358
pure function fnv_1_hasher( key )
327359
!! Version: Experimental
328360
!!

src/stdlib_linalg.fypp

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,8 @@ module stdlib_linalg
1616
implicit none
1717
private
1818

19+
public :: det
20+
public :: operator(.det.)
1921
public :: diag
2022
public :: eye
2123
public :: lstsq
@@ -30,6 +32,9 @@ module stdlib_linalg
3032
public :: is_hermitian
3133
public :: is_triangular
3234
public :: is_hessenberg
35+
36+
! Export linalg error handling
37+
public :: linalg_state_type, linalg_error_handling
3338

3439
interface diag
3540
!! version: experimental
@@ -263,6 +268,108 @@ module stdlib_linalg
263268
#:endfor
264269
end interface lstsq
265270

271+
interface det
272+
!! version: experimental
273+
!!
274+
!! Computes the determinant of a square matrix
275+
!! ([Specification](../page/specs/stdlib_linalg.html#det-computes-the-determinant-of-a-square-matrix))
276+
!!
277+
!!### Summary
278+
!! Interface for computing matrix determinant.
279+
!!
280+
!!### Description
281+
!!
282+
!! This interface provides methods for computing the determinant of a matrix.
283+
!! Supported data types include `real` and `complex`.
284+
!!
285+
!!@note The provided functions are intended for square matrices only.
286+
!!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
287+
!!
288+
!!### Example
289+
!!
290+
!!```fortran
291+
!!
292+
!! real(sp) :: a(3,3), d
293+
!! type(linalg_state_type) :: state
294+
!! a = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
295+
!!
296+
!! ! ...
297+
!! d = det(a,err=state)
298+
!! if (state%ok()) then
299+
!! print *, 'Success! det=',d
300+
!! else
301+
!! print *, state%print()
302+
!! endif
303+
!! ! ...
304+
!!```
305+
!!
306+
#:for rk,rt in RC_KINDS_TYPES
307+
#:if rk!="xdp"
308+
module procedure stdlib_linalg_${rt[0]}$${rk}$determinant
309+
module procedure stdlib_linalg_pure_${rt[0]}$${rk}$determinant
310+
#:endif
311+
#:endfor
312+
end interface det
313+
314+
interface operator(.det.)
315+
!! version: experimental
316+
!!
317+
!! Determinant operator of a square matrix
318+
!! ([Specification](../page/specs/stdlib_linalg.html#det-determinant-operator-of-a-square-matrix))
319+
!!
320+
!!### Summary
321+
!! Pure operator interface for computing matrix determinant.
322+
!!
323+
!!### Description
324+
!!
325+
!! This pure operator interface provides a convenient way to compute the determinant of a matrix.
326+
!! Supported data types include real and complex.
327+
!!
328+
!!@note The provided functions are intended for square matrices.
329+
!!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
330+
!!
331+
!!### Example
332+
!!
333+
!!```fortran
334+
!!
335+
!! ! ...
336+
!! real(sp) :: matrix(3,3), d
337+
!! matrix = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
338+
!! d = .det.matrix
339+
!! ! ...
340+
!!
341+
!!```
342+
!
343+
#:for rk,rt in RC_KINDS_TYPES
344+
#:if rk!="xdp"
345+
module procedure stdlib_linalg_pure_${rt[0]}$${rk}$determinant
346+
#:endif
347+
#:endfor
348+
end interface operator(.det.)
349+
350+
interface
351+
#:for rk,rt in RC_KINDS_TYPES
352+
#:if rk!="xdp"
353+
module function stdlib_linalg_${rt[0]}$${rk}$determinant(a,overwrite_a,err) result(det)
354+
!> Input matrix a[m,n]
355+
${rt}$, intent(inout), target :: a(:,:)
356+
!> [optional] Can A data be overwritten and destroyed?
357+
logical(lk), optional, intent(in) :: overwrite_a
358+
!> State return flag.
359+
type(linalg_state_type), intent(out) :: err
360+
!> Matrix determinant
361+
${rt}$ :: det
362+
end function stdlib_linalg_${rt[0]}$${rk}$determinant
363+
pure module function stdlib_linalg_pure_${rt[0]}$${rk}$determinant(a) result(det)
364+
!> Input matrix a[m,n]
365+
${rt}$, intent(in) :: a(:,:)
366+
!> Matrix determinant
367+
${rt}$ :: det
368+
end function stdlib_linalg_pure_${rt[0]}$${rk}$determinant
369+
#:endif
370+
#:endfor
371+
end interface
372+
266373
contains
267374

268375

0 commit comments

Comments
 (0)