@@ -6,17 +6,17 @@ module stdlib_linalg_state
6
6
!! Provides a state/error handling derived type for advanced error handling of
7
7
!! BLAS/LAPACK based linear algebra procedures. All procedures are pure.
8
8
!! !! ([Specification](../page/specs/stdlib_linalg.html))
9
- use stdlib_linalg_constants,only:ilp,lk
10
- use stdlib_kinds
11
- use stdlib_io
12
- use iso_fortran_env,only: stderr => error_unit
9
+ use stdlib_linalg_constants,only: ilp,sp,dp,qp ,lk
10
+ use stdlib_kinds, only: int8, int16, int32, int64
11
+ use stdlib_io, only: FMT_REAL_SP, FMT_REAL_DP, FMT_REAL_QP, FMT_COMPLEX_SP, FMT_COMPLEX_DP, &
12
+ FMT_COMPLEX_QP
13
13
implicit none(type,external)
14
14
private
15
15
16
16
!> Version: experimental
17
17
!>
18
18
!> A fixed-storage state variable for error handling of linear algebra routines
19
- public :: linalg_state
19
+ public :: linalg_state_type
20
20
21
21
!> Version: experimental
22
22
!>
@@ -32,19 +32,19 @@ module stdlib_linalg_state
32
32
public :: operator(>),operator(>=)
33
33
34
34
!> State return types
35
- integer(ilp),parameter,public :: LINALG_SUCCESS = 0_ilp
36
- integer(ilp),parameter,public :: LINALG_VALUE_ERROR = -1_ilp
37
- integer(ilp),parameter,public :: LINALG_ERROR = -2_ilp
35
+ integer(ilp),parameter,public :: LINALG_SUCCESS = 0_ilp
36
+ integer(ilp),parameter,public :: LINALG_VALUE_ERROR = -1_ilp
37
+ integer(ilp),parameter,public :: LINALG_ERROR = -2_ilp
38
38
integer(ilp),parameter,public :: LINALG_INTERNAL_ERROR = -3_ilp
39
39
40
40
!> Use fixed-size character storage for performance
41
41
integer(ilp),parameter :: MSG_LENGTH = 512_ilp
42
42
integer(ilp),parameter :: NAME_LENGTH = 32_ilp
43
43
44
- !> `linalg_state ` defines a state return type for a
44
+ !> `linalg_state_type ` defines a state return type for a
45
45
!> linear algebra routine. State contains a status flag, a comment, and a
46
46
!> procedure specifier that can be used to mark where the error happened
47
- type :: linalg_state
47
+ type :: linalg_state_type
48
48
49
49
!> The current exit state
50
50
integer(ilp) :: state = LINALG_SUCCESS
@@ -58,17 +58,17 @@ module stdlib_linalg_state
58
58
contains
59
59
60
60
!> Cleanup
61
- procedure :: destroy => state_destroy
61
+ procedure :: destroy => state_destroy
62
62
63
63
!> Print error message
64
- procedure :: print => state_print
64
+ procedure :: print => state_print
65
65
procedure :: print_msg => state_message
66
66
67
67
!> State properties
68
- procedure :: ok => state_is_ok
69
- procedure :: error => state_is_error
68
+ procedure :: ok => state_is_ok
69
+ procedure :: error => state_is_error
70
70
71
- end type linalg_state
71
+ end type linalg_state_type
72
72
73
73
!> Comparison operators
74
74
interface operator(==)
@@ -96,15 +96,15 @@ module stdlib_linalg_state
96
96
module procedure flag_ge_state
97
97
end interface
98
98
99
- interface linalg_state
99
+ interface linalg_state_type
100
100
module procedure new_state
101
101
module procedure new_state_nowhere
102
- end interface linalg_state
102
+ end interface linalg_state_type
103
103
104
104
contains
105
105
106
106
!> Interface to print linalg state flags
107
- pure function LINALG_MESSAGE (flag) result(msg)
107
+ pure function linalg_message (flag) result(msg)
108
108
integer(ilp),intent(in) :: flag
109
109
character(len=:),allocatable :: msg
110
110
@@ -116,12 +116,12 @@ module stdlib_linalg_state
116
116
case default; msg = 'ERROR/INVALID FLAG'
117
117
end select
118
118
119
- end function LINALG_MESSAGE
119
+ end function linalg_message
120
120
121
121
!> Flow control: on output flag present, return it; otherwise, halt on error
122
122
pure subroutine linalg_error_handling(ierr,ierr_out)
123
- type(linalg_state ),intent(in) :: ierr
124
- type(linalg_state ),optional,intent(out) :: ierr_out
123
+ type(linalg_state_type ),intent(in) :: ierr
124
+ type(linalg_state_type ),optional,intent(out) :: ierr_out
125
125
126
126
character(len=:),allocatable :: err_msg
127
127
@@ -137,20 +137,20 @@ module stdlib_linalg_state
137
137
138
138
!> Formatted message
139
139
pure function state_message(this) result(msg)
140
- class(linalg_state ),intent(in) :: this
140
+ class(linalg_state_type ),intent(in) :: this
141
141
character(len=:),allocatable :: msg
142
142
143
143
if (this%state == LINALG_SUCCESS) then
144
144
msg = 'Success!'
145
145
else
146
- msg = LINALG_MESSAGE (this%state)//': '//trim(this%message)
146
+ msg = linalg_message (this%state)//': '//trim(this%message)
147
147
end if
148
148
149
149
end function state_message
150
150
151
151
!> Produce a nice error string
152
152
pure function state_print(this) result(msg)
153
- class(linalg_state ),intent(in) :: this
153
+ class(linalg_state_type ),intent(in) :: this
154
154
character(len=:),allocatable :: msg
155
155
156
156
if (len_trim(this%where_at) > 0) then
@@ -165,7 +165,7 @@ module stdlib_linalg_state
165
165
166
166
!> Cleanup the object
167
167
elemental subroutine state_destroy(this)
168
- class(linalg_state ),intent(inout) :: this
168
+ class(linalg_state_type ),intent(inout) :: this
169
169
170
170
this%state = LINALG_SUCCESS
171
171
this%message = repeat(' ',len(this%message))
@@ -175,102 +175,102 @@ module stdlib_linalg_state
175
175
176
176
!> Check if the current state is successful
177
177
elemental logical(lk) function state_is_ok(this)
178
- class(linalg_state ),intent(in) :: this
178
+ class(linalg_state_type ),intent(in) :: this
179
179
state_is_ok = this%state == LINALG_SUCCESS
180
180
end function state_is_ok
181
181
182
182
!> Check if the current state is an error state
183
183
elemental logical(lk) function state_is_error(this)
184
- class(linalg_state ),intent(in) :: this
184
+ class(linalg_state_type ),intent(in) :: this
185
185
state_is_error = this%state /= LINALG_SUCCESS
186
186
end function state_is_error
187
187
188
188
!> Compare an error state with an integer flag
189
189
elemental logical(lk) function state_eq_flag(err,flag)
190
- type(linalg_state ),intent(in) :: err
190
+ type(linalg_state_type ),intent(in) :: err
191
191
integer,intent(in) :: flag
192
192
state_eq_flag = err%state == flag
193
193
end function state_eq_flag
194
194
195
195
!> Compare an integer flag with the error state
196
196
elemental logical(lk) function flag_eq_state(flag,err)
197
197
integer,intent(in) :: flag
198
- type(linalg_state ),intent(in) :: err
198
+ type(linalg_state_type ),intent(in) :: err
199
199
flag_eq_state = err%state == flag
200
200
end function flag_eq_state
201
201
202
202
!> Compare the error state with an integer flag
203
203
elemental logical(lk) function state_neq_flag(err,flag)
204
- type(linalg_state ),intent(in) :: err
204
+ type(linalg_state_type ),intent(in) :: err
205
205
integer,intent(in) :: flag
206
206
state_neq_flag = .not. state_eq_flag(err,flag)
207
207
end function state_neq_flag
208
208
209
209
!> Compare an integer flag with the error state
210
210
elemental logical(lk) function flag_neq_state(flag,err)
211
211
integer,intent(in) :: flag
212
- type(linalg_state ),intent(in) :: err
212
+ type(linalg_state_type ),intent(in) :: err
213
213
flag_neq_state = .not. state_eq_flag(err,flag)
214
214
end function flag_neq_state
215
215
216
216
!> Compare the error state with an integer flag
217
217
elemental logical(lk) function state_lt_flag(err,flag)
218
- type(linalg_state ),intent(in) :: err
218
+ type(linalg_state_type ),intent(in) :: err
219
219
integer,intent(in) :: flag
220
220
state_lt_flag = err%state < flag
221
221
end function state_lt_flag
222
222
223
223
!> Compare the error state with an integer flag
224
224
elemental logical(lk) function state_le_flag(err,flag)
225
- type(linalg_state ),intent(in) :: err
225
+ type(linalg_state_type ),intent(in) :: err
226
226
integer,intent(in) :: flag
227
227
state_le_flag = err%state <= flag
228
228
end function state_le_flag
229
229
230
230
!> Compare an integer flag with the error state
231
231
elemental logical(lk) function flag_lt_state(flag,err)
232
232
integer,intent(in) :: flag
233
- type(linalg_state ),intent(in) :: err
233
+ type(linalg_state_type ),intent(in) :: err
234
234
flag_lt_state = err%state < flag
235
235
end function flag_lt_state
236
236
237
237
!> Compare an integer flag with the error state
238
238
elemental logical(lk) function flag_le_state(flag,err)
239
239
integer,intent(in) :: flag
240
- type(linalg_state ),intent(in) :: err
240
+ type(linalg_state_type ),intent(in) :: err
241
241
flag_le_state = err%state <= flag
242
242
end function flag_le_state
243
243
244
244
!> Compare the error state with an integer flag
245
245
elemental logical(lk) function state_gt_flag(err,flag)
246
- type(linalg_state ),intent(in) :: err
246
+ type(linalg_state_type ),intent(in) :: err
247
247
integer,intent(in) :: flag
248
248
state_gt_flag = err%state > flag
249
249
end function state_gt_flag
250
250
251
251
!> Compare the error state with an integer flag
252
252
elemental logical(lk) function state_ge_flag(err,flag)
253
- type(linalg_state ),intent(in) :: err
253
+ type(linalg_state_type ),intent(in) :: err
254
254
integer,intent(in) :: flag
255
255
state_ge_flag = err%state >= flag
256
256
end function state_ge_flag
257
257
258
258
!> Compare an integer flag with the error state
259
259
elemental logical(lk) function flag_gt_state(flag,err)
260
260
integer,intent(in) :: flag
261
- type(linalg_state ),intent(in) :: err
261
+ type(linalg_state_type ),intent(in) :: err
262
262
flag_gt_state = err%state > flag
263
263
end function flag_gt_state
264
264
265
265
!> Compare an integer flag with the error state
266
266
elemental logical(lk) function flag_ge_state(flag,err)
267
267
integer,intent(in) :: flag
268
- type(linalg_state ),intent(in) :: err
268
+ type(linalg_state_type ),intent(in) :: err
269
269
flag_ge_state = err%state >= flag
270
270
end function flag_ge_state
271
271
272
272
!> Error creation message, with location location
273
- pure type(linalg_state ) function new_state(where_at,flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
273
+ pure type(linalg_state_type ) function new_state(where_at,flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
274
274
v1,v2,v3,v4,v5)
275
275
276
276
!> Location
@@ -294,7 +294,7 @@ module stdlib_linalg_state
294
294
end function new_state
295
295
296
296
!> Error creation message, from N input variables (numeric or strings)
297
- pure type(linalg_state ) function new_state_nowhere(flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
297
+ pure type(linalg_state_type ) function new_state_nowhere(flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
298
298
v1,v2,v3,v4,v5) result(new_state)
299
299
300
300
!> Input error flag
0 commit comments