@@ -46,32 +46,32 @@ submodule (stdlib_linalg) stdlib_linalg_schur
46
46
! Success
47
47
case (-1_ilp)
48
48
! 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')
50
50
case (-2_ilp)
51
51
! 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')
53
53
case (-4_ilp,-6_ilp)
54
54
! 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])
56
56
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])
58
58
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')
60
60
case (1_ilp:)
61
61
62
62
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')
64
64
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')
66
66
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')
68
68
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])
70
70
end if
71
71
72
72
case default
73
73
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)
75
75
76
76
end select
77
77
@@ -140,7 +140,7 @@ submodule (stdlib_linalg) stdlib_linalg_schur
140
140
!> [optional] Can A data be overwritten and destroyed?
141
141
logical(lk), optional, intent(in) :: overwrite_a
142
142
!> [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
144
144
145
145
! Local variables
146
146
integer(ilp) :: m,n,mt,nt,ldvs,nvs,lde,lwork,sdim,info
@@ -151,7 +151,7 @@ submodule (stdlib_linalg) stdlib_linalg_schur
151
151
${rt}$, target :: vs_dummy(1,1)
152
152
${rt}$, pointer :: vs(:,:),work(:),eigs(:)#{if rt.startswith('r')}#,eigi(:)#{endif}#
153
153
character :: jobvs,sort
154
- type(linalg_state ) :: err0
154
+ type(linalg_state_type ) :: err0
155
155
156
156
! Problem size
157
157
m = size(a, 1, kind=ilp)
@@ -161,12 +161,12 @@ submodule (stdlib_linalg) stdlib_linalg_schur
161
161
162
162
! Validate dimensions
163
163
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])
165
165
call linalg_error_handling(err0, err)
166
166
return
167
167
end if
168
168
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], &
170
170
'should be',[m,n])
171
171
call linalg_error_handling(err0, err)
172
172
return
@@ -205,7 +205,7 @@ submodule (stdlib_linalg) stdlib_linalg_schur
205
205
nvs = size(vs, 2, kind=ilp)
206
206
207
207
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], &
209
209
'should be n=',n)
210
210
goto 1
211
211
end if
@@ -232,45 +232,37 @@ submodule (stdlib_linalg) stdlib_linalg_schur
232
232
end if
233
233
234
234
!> 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)
239
237
#:if rt.startswith('c')
240
238
eigs => eigvals
241
239
local_eigs = .false.
242
240
#: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
250
241
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
255
249
! Use A storage if possible
256
250
if (overwrite_a_) then
257
251
eigs => a(:,1)
252
+ #:if rt.startswith('r')
258
253
eigi => a(:,2)
254
+ #:endif
259
255
else
260
256
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
267
259
268
260
#:if rt.startswith('c')
269
261
allocate(rwork(n))
270
262
#:endif
271
263
272
264
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, &
274
266
'should be >=',n)
275
267
goto 2
276
268
end if
0 commit comments