Skip to content

Commit ead68dd

Browse files
committed
fix, export interface
1 parent 95a4900 commit ead68dd

File tree

3 files changed

+32
-37
lines changed

3 files changed

+32
-37
lines changed

src/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ set(fppFiles
3636
stdlib_linalg_state.fypp
3737
stdlib_linalg_svd.fypp
3838
stdlib_linalg_cholesky.fypp
39+
stdlib_linalg_schur.fypp
3940
stdlib_optval.fypp
4041
stdlib_selection.fypp
4142
stdlib_sorting.fypp

src/stdlib_linalg.fypp

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,8 @@ module stdlib_linalg
4444
public :: cross_product
4545
public :: qr
4646
public :: qr_space
47+
public :: schur
48+
public :: schur_space
4749
public :: is_square
4850
public :: is_diagonal
4951
public :: is_symmetric

src/stdlib_linalg_schur.fypp

Lines changed: 29 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -46,32 +46,32 @@ submodule (stdlib_linalg) stdlib_linalg_schur
4646
! Success
4747
case (-1_ilp)
4848
! Vector not wanted, but task is wrong
49-
err = linalg_state(this, LINALG_INTERNAL_ERROR,'Invalid Schur vector task request')
49+
err = linalg_state_type(this, LINALG_INTERNAL_ERROR,'Invalid Schur vector task request')
5050
case (-2_ilp)
5151
! Vector not wanted, but task is wrong
52-
err = linalg_state(this, LINALG_INTERNAL_ERROR,'Invalid sorting task request')
52+
err = linalg_state_type(this, LINALG_INTERNAL_ERROR,'Invalid sorting task request')
5353
case (-4_ilp,-6_ilp)
5454
! Vector not wanted, but task is wrong
55-
err = linalg_state(this, LINALG_VALUE_ERROR,'Invalid/non-square input matrix size:',[m,n])
55+
err = linalg_state_type(this, LINALG_VALUE_ERROR,'Invalid/non-square input matrix size:',[m,n])
5656
case (-11_ilp)
57-
err = linalg_state(this, LINALG_VALUE_ERROR,'Schur vector matrix has insufficient size',[ldvs,n])
57+
err = linalg_state_type(this, LINALG_VALUE_ERROR,'Schur vector matrix has insufficient size',[ldvs,n])
5858
case (-13_ilp)
59-
err = linalg_state(this, LINALG_INTERNAL_ERROR,'Insufficient working storage size')
59+
err = linalg_state_type(this, LINALG_INTERNAL_ERROR,'Insufficient working storage size')
6060
case (1_ilp:)
6161

6262
if (info==n+2) then
63-
err = linalg_state(this, LINALG_ERROR, 'Ill-conditioned problem: could not sort eigenvalues')
63+
err = linalg_state_type(this, LINALG_ERROR, 'Ill-conditioned problem: could not sort eigenvalues')
6464
elseif (info==n+1) then
65-
err = linalg_state(this, LINALG_ERROR, 'Some selected eigenvalues lost property due to sorting')
65+
err = linalg_state_type(this, LINALG_ERROR, 'Some selected eigenvalues lost property due to sorting')
6666
elseif (info==n) then
67-
err = linalg_state(this, LINALG_ERROR, 'Convergence failure: no converged eigenvalues')
67+
err = linalg_state_type(this, LINALG_ERROR, 'Convergence failure: no converged eigenvalues')
6868
else
69-
err = linalg_state(this, LINALG_ERROR, 'Convergence failure; converged range is',[info,n])
69+
err = linalg_state_type(this, LINALG_ERROR, 'Convergence failure; converged range is',[info,n])
7070
end if
7171

7272
case default
7373

74-
err = linalg_state(this, LINALG_INTERNAL_ERROR, 'GEES catastrophic error: info=', info)
74+
err = linalg_state_type(this, LINALG_INTERNAL_ERROR, 'GEES catastrophic error: info=', info)
7575

7676
end select
7777

@@ -140,7 +140,7 @@ submodule (stdlib_linalg) stdlib_linalg_schur
140140
!> [optional] Can A data be overwritten and destroyed?
141141
logical(lk), optional, intent(in) :: overwrite_a
142142
!> [optional] State return flag. On error if not requested, the code will stop
143-
type(linalg_state), optional, intent(out) :: err
143+
type(linalg_state_type), optional, intent(out) :: err
144144

145145
! Local variables
146146
integer(ilp) :: m,n,mt,nt,ldvs,nvs,lde,lwork,sdim,info
@@ -151,7 +151,7 @@ submodule (stdlib_linalg) stdlib_linalg_schur
151151
${rt}$, target :: vs_dummy(1,1)
152152
${rt}$, pointer :: vs(:,:),work(:),eigs(:)#{if rt.startswith('r')}#,eigi(:)#{endif}#
153153
character :: jobvs,sort
154-
type(linalg_state) :: err0
154+
type(linalg_state_type) :: err0
155155

156156
! Problem size
157157
m = size(a, 1, kind=ilp)
@@ -161,12 +161,12 @@ submodule (stdlib_linalg) stdlib_linalg_schur
161161

162162
! Validate dimensions
163163
if (m/=n .or. m<=0 .or. n<=0) then
164-
err0 = linalg_state(this, LINALG_VALUE_ERROR, 'Matrix A must be square: size(a)=',[m,n])
164+
err0 = linalg_state_type(this, LINALG_VALUE_ERROR, 'Matrix A must be square: size(a)=',[m,n])
165165
call linalg_error_handling(err0, err)
166166
return
167167
end if
168168
if (mt/=nt .or. mt/=n .or. nt/=n) then
169-
err0 = linalg_state(this, LINALG_VALUE_ERROR, 'Matrix T must be square: size(T)=',[mt,nt], &
169+
err0 = linalg_state_type(this, LINALG_VALUE_ERROR, 'Matrix T must be square: size(T)=',[mt,nt], &
170170
'should be',[m,n])
171171
call linalg_error_handling(err0, err)
172172
return
@@ -205,7 +205,7 @@ submodule (stdlib_linalg) stdlib_linalg_schur
205205
nvs = size(vs, 2, kind=ilp)
206206

207207
if (ldvs<n .or. nvs/=n) then
208-
err0 = linalg_state(this, LINALG_VALUE_ERROR, 'Schur vectors size=',[ldvs,nvs], &
208+
err0 = linalg_state_type(this, LINALG_VALUE_ERROR, 'Schur vectors size=',[ldvs,nvs], &
209209
'should be n=',n)
210210
goto 1
211211
end if
@@ -232,45 +232,37 @@ submodule (stdlib_linalg) stdlib_linalg_schur
232232
end if
233233

234234
!> User or self-allocated eigenvalue storage
235-
if (present(eigvals)) then
236-
237-
lde = size(eigvals, 1, kind=ilp)
238-
235+
if (present(eigvals)) then
236+
lde = size(eigvals, 1, kind=ilp)
239237
#:if rt.startswith('c')
240238
eigs => eigvals
241239
local_eigs = .false.
242240
#:else
243-
! use A storage if possible
244-
if (overwrite_a_) then
245-
eigs => a(:,1)
246-
eigi => a(:,2)
247-
else
248-
allocate(eigs(n),eigi(n))
249-
end if
250241
local_eigs = .true.
251-
#:endif
252-
253-
else
254-
242+
#:endif
243+
else
244+
local_eigs = .true.
245+
lde = n
246+
end if
247+
248+
if (local_eigs) then
255249
! Use A storage if possible
256250
if (overwrite_a_) then
257251
eigs => a(:,1)
252+
#:if rt.startswith('r')
258253
eigi => a(:,2)
254+
#:endif
259255
else
260256
allocate(eigs(n)#{if rt.startswith('r')}#,eigi(n)#{endif}#)
261-
end if
262-
263-
local_eigs = .true.
264-
lde = n
265-
266-
end if
257+
end if
258+
endif
267259

268260
#:if rt.startswith('c')
269261
allocate(rwork(n))
270262
#:endif
271263

272264
if (lde<n) then
273-
err0 = linalg_state(this, LINALG_VALUE_ERROR, 'Insufficient eigenvalue array size=',lde, &
265+
err0 = linalg_state_type(this, LINALG_VALUE_ERROR, 'Insufficient eigenvalue array size=',lde, &
274266
'should be >=',n)
275267
goto 2
276268
end if

0 commit comments

Comments
 (0)