|
3 | 3 | submodule (stdlib_linalg) stdlib_linalg_qr |
4 | 4 | use stdlib_linalg_constants |
5 | 5 | use stdlib_linalg_lapack, only: geqrf, orgqr, ungqr |
6 | | - use stdlib_linalg_lapack_aux, only: handle_geqrf_info |
| 6 | + use stdlib_linalg_lapack_aux, only: handle_geqrf_info, handle_orgqr_info |
7 | 7 | use stdlib_linalg_state, only: linalg_state_type, linalg_error_handling, LINALG_ERROR, & |
8 | 8 | LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR |
9 | 9 | implicit none |
@@ -43,29 +43,6 @@ submodule (stdlib_linalg) stdlib_linalg_qr |
43 | 43 |
|
44 | 44 | end subroutine check_problem_size |
45 | 45 |
|
46 | | - elemental subroutine handle_orgqr_info(info,m,n,k,lwork,err) |
47 | | - integer(ilp), intent(in) :: info,m,n,k,lwork |
48 | | - type(linalg_state_type), intent(out) :: err |
49 | | - |
50 | | - ! Process output |
51 | | - select case (info) |
52 | | - case (0) |
53 | | - ! Success |
54 | | - case (-1) |
55 | | - err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size m=',m) |
56 | | - case (-2) |
57 | | - err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size n=',n) |
58 | | - case (-4) |
59 | | - err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid k=min(m,n)=',k) |
60 | | - case (-5) |
61 | | - err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size a=',[m,n]) |
62 | | - case (-8) |
63 | | - err = linalg_state_type(this,LINALG_ERROR,'invalid input for lwork=',lwork) |
64 | | - case default |
65 | | - err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error') |
66 | | - end select |
67 | | - |
68 | | - end subroutine handle_orgqr_info |
69 | 46 |
|
70 | 47 | #:for rk,rt,ri in RC_KINDS_TYPES |
71 | 48 |
|
@@ -103,7 +80,7 @@ submodule (stdlib_linalg) stdlib_linalg_qr |
103 | 80 | lwork_ord = -1_ilp |
104 | 81 | call #{if rt.startswith('complex')}# ungqr #{else}# orgqr #{endif}# & |
105 | 82 | (m,m,k,a_dummy,m,tau_dummy,work_dummy,lwork_ord,info) |
106 | | - call handle_orgqr_info(info,m,n,k,lwork_ord,err0) |
| 83 | + call handle_orgqr_info(this,info,m,n,k,lwork_ord,err0) |
107 | 84 | if (err0%error()) then |
108 | 85 | call linalg_error_handling(err0,err) |
109 | 86 | return |
@@ -215,7 +192,7 @@ submodule (stdlib_linalg) stdlib_linalg_qr |
215 | 192 | ! Convert K elementary reflectors tau(1:k) -> orthogonal matrix Q |
216 | 193 | call #{if rt.startswith('complex')}# ungqr #{else}# orgqr #{endif}# & |
217 | 194 | (q1,q2,k,amat,lda,tau,work,lwork,info) |
218 | | - call handle_orgqr_info(info,m,n,k,lwork,err0) |
| 195 | + call handle_orgqr_info(this,info,m,n,k,lwork,err0) |
219 | 196 |
|
220 | 197 | ! Copy result back to Q |
221 | 198 | if (.not.use_q_matrix) q = amat(:q1,:q2) |
|
0 commit comments