LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ serrtsqr()

subroutine serrtsqr ( character*3  path,
integer  nunit 
)

DERRTSQR

Purpose:
 DERRTSQR tests the error exits for the REAL routines
 that use the TSQR decomposition of a general matrix.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file serrtsqr.f.

55 IMPLICIT NONE
56*
57* -- LAPACK test routine --
58* -- LAPACK is a software package provided by Univ. of Tennessee, --
59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60*
61* .. Scalar Arguments ..
62 CHARACTER*3 PATH
63 INTEGER NUNIT
64* ..
65*
66* =====================================================================
67*
68* .. Parameters ..
69 INTEGER NMAX
70 parameter( nmax = 2 )
71* ..
72* .. Local Scalars ..
73 INTEGER I, INFO, J, MB, NB
74* ..
75* .. Local Arrays ..
76 REAL A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77 $ C( NMAX, NMAX ), TAU(NMAX*2)
78* ..
79* .. External Subroutines ..
80 EXTERNAL alaesm, chkxer, sgeqr,
81 $ sgemqr, sgelq, sgemlq
82* ..
83* .. Scalars in Common ..
84 LOGICAL LERR, OK
85 CHARACTER*32 SRNAMT
86 INTEGER INFOT, NOUT
87* ..
88* .. Common blocks ..
89 COMMON / infoc / infot, nout, ok, lerr
90 COMMON / srnamc / srnamt
91* ..
92* .. Intrinsic Functions ..
93 INTRINSIC real
94* ..
95* .. Executable Statements ..
96*
97 nout = nunit
98 WRITE( nout, fmt = * )
99*
100* Set the variables to innocuous values.
101*
102 DO j = 1, nmax
103 DO i = 1, nmax
104 a( i, j ) = 1. / real( i+j )
105 c( i, j ) = 1. / real( i+j )
106 t( i, j ) = 1. / real( i+j )
107 END DO
108 w( j ) = 0.
109 END DO
110 ok = .true.
111*
112* Error exits for TS factorization
113*
114* SGEQR
115*
116 srnamt = 'SGEQR'
117 infot = 1
118 CALL sgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
119 CALL chkxer( 'SGEQR', infot, nout, lerr, ok )
120 infot = 2
121 CALL sgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
122 CALL chkxer( 'SGEQR', infot, nout, lerr, ok )
123 infot = 4
124 CALL sgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
125 CALL chkxer( 'SGEQR', infot, nout, lerr, ok )
126 infot = 6
127 CALL sgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
128 CALL chkxer( 'SGEQR', infot, nout, lerr, ok )
129 infot = 8
130 CALL sgeqr( 3, 2, a, 3, tau, 7, w, 0, info )
131 CALL chkxer( 'SGEQR', infot, nout, lerr, ok )
132*
133* SLATSQR
134*
135 mb = 1
136 nb = 1
137 srnamt = 'SLATSQR'
138 infot = 1
139 CALL slatsqr( -1, 0, mb, nb, a, 1, tau, 1, w, 1, info )
140 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
141 infot = 2
142 CALL slatsqr( 1, 2, mb, nb, a, 1, tau, 1, w, 1, info )
143 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
144 CALL slatsqr( 0, -1, mb, nb, a, 1, tau, 1, w, 1, info )
145 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
146 infot = 3
147 CALL slatsqr( 2, 1, -1, nb, a, 2, tau, 1, w, 1, info )
148 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
149 infot = 4
150 CALL slatsqr( 2, 1, mb, 2, a, 2, tau, 1, w, 1, info )
151 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
152 infot = 6
153 CALL slatsqr( 2, 1, mb, nb, a, 1, tau, 1, w, 1, info )
154 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
155 infot = 8
156 CALL slatsqr( 2, 1, mb, nb, a, 2, tau, 0, w, 1, info )
157 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
158 infot = 10
159 CALL slatsqr( 2, 1, mb, nb, a, 2, tau, 2, w, 0, info )
160 CALL chkxer( 'SLATSQR', infot, nout, lerr, ok )
161*
162* SGEMQR
163*
164 tau(1)=1
165 tau(2)=1
166 tau(3)=1
167 tau(4)=1
168 srnamt = 'SGEMQR'
169 nb=1
170 infot = 1
171 CALL sgemqr( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
172 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
173 infot = 2
174 CALL sgemqr( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
175 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
176 infot = 3
177 CALL sgemqr( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
178 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
179 infot = 4
180 CALL sgemqr( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
181 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
182 infot = 5
183 CALL sgemqr( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
184 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
185 infot = 5
186 CALL sgemqr( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
187 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
188 infot = 7
189 CALL sgemqr( 'L', 'N', 2, 1, 0, a, 0, tau, 1, c, 1, w, 1,info)
190 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
191 infot = 9
192 CALL sgemqr( 'R', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
193 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
194 infot = 9
195 CALL sgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
196 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
197 infot = 11
198 CALL sgemqr( 'L', 'N', 2, 1, 1, a, 2, tau, 6, c, 0, w, 1,info)
199 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
200 infot = 13
201 CALL sgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
202 CALL chkxer( 'SGEMQR', infot, nout, lerr, ok )
203*
204* SGELQ
205*
206 srnamt = 'SGELQ'
207 infot = 1
208 CALL sgelq( -1, 0, a, 1, tau, 1, w, 1, info )
209 CALL chkxer( 'SGELQ', infot, nout, lerr, ok )
210 infot = 2
211 CALL sgelq( 0, -1, a, 1, tau, 1, w, 1, info )
212 CALL chkxer( 'SGELQ', infot, nout, lerr, ok )
213 infot = 4
214 CALL sgelq( 1, 1, a, 0, tau, 1, w, 1, info )
215 CALL chkxer( 'SGELQ', infot, nout, lerr, ok )
216 infot = 6
217 CALL sgelq( 2, 3, a, 3, tau, 1, w, 1, info )
218 CALL chkxer( 'SGELQ', infot, nout, lerr, ok )
219 infot = 8
220 CALL sgelq( 2, 3, a, 3, tau, 7, w, 0, info )
221 CALL chkxer( 'SGELQ', infot, nout, lerr, ok )
222*
223* SLASWLQ
224*
225 mb = 1
226 nb = 1
227 srnamt = 'SLASWLQ'
228 infot = 1
229 CALL slaswlq( -1, 0, mb, nb, a, 1, tau, 1, w, 1, info )
230 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
231 infot = 2
232 CALL slaswlq( 2, 1, mb, nb, a, 1, tau, 1, w, 1, info )
233 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
234 CALL slaswlq( 0, -1, mb, nb, a, 1, tau, 1, w, 1, info )
235 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
236 infot = 3
237 CALL slaswlq( 1, 2, -1, nb, a, 1, tau, 1, w, 1, info )
238 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
239 CALL slaswlq( 1, 1, 2, nb, a, 1, tau, 1, w, 1, info )
240 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
241 infot = 4
242 CALL slaswlq( 1, 2, mb, -1, a, 1, tau, 1, w, 1, info )
243 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
244 infot = 6
245 CALL slaswlq( 1, 2, mb, nb, a, 0, tau, 1, w, 1, info )
246 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
247 infot = 8
248 CALL slaswlq( 1, 2, mb, nb, a, 1, tau, 0, w, 1, info )
249 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
250 infot = 10
251 CALL slaswlq( 1, 2, mb, nb, a, 1, tau, 1, w, 0, info )
252 CALL chkxer( 'SLASWLQ', infot, nout, lerr, ok )
253*
254* SGEMLQ
255*
256 tau(1)=1
257 tau(2)=1
258 srnamt = 'SGEMLQ'
259 nb=1
260 infot = 1
261 CALL sgemlq( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
262 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
263 infot = 2
264 CALL sgemlq( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
265 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
266 infot = 3
267 CALL sgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
268 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
269 infot = 4
270 CALL sgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
271 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
272 infot = 5
273 CALL sgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
274 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
275 infot = 5
276 CALL sgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
277 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
278 infot = 7
279 CALL sgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
280 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
281 infot = 9
282 CALL sgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
283 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
284 infot = 9
285 CALL sgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
286 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
287 infot = 11
288 CALL sgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
289 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
290 infot = 13
291 CALL sgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
292 CALL chkxer( 'SGEMLQ', infot, nout, lerr, ok )
293*
294* Print a summary line.
295*
296 CALL alaesm( path, ok, nout )
297*
298 RETURN
299*
300* End of SERRTSQR
301*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgelq
subroutine sgelq(m, n, a, lda, t, tsize, work, lwork, info)
SGELQ
Definition sgelq.f:174
sgemlq
subroutine sgemlq(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
SGEMLQ
Definition sgemlq.f:172
sgemqr
subroutine sgemqr(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
SGEMQR
Definition sgemqr.f:174
sgeqr
subroutine sgeqr(m, n, a, lda, t, tsize, work, lwork, info)
SGEQR
Definition sgeqr.f:176
slaswlq
subroutine slaswlq(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
SLASWLQ
Definition slaswlq.f:167
slatsqr
subroutine slatsqr(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
SLATSQR
Definition slatsqr.f:169
Here is the call graph for this function:
Here is the caller graph for this function: