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

◆ derrtsqr()

subroutine derrtsqr ( character*3  path,
integer  nunit 
)

DERRTSQR

Purpose:
 DERRTSQR tests the error exits for the DOUBLE PRECISION 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 derrtsqr.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 DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77 $ C( NMAX, NMAX ), TAU(NMAX*2)
78* ..
79* .. External Subroutines ..
80 EXTERNAL alaesm, chkxer, dgeqr,
81 $ dgemqr, dgelq, dgemlq
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 dble
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.d0 / dble( i+j )
105 c( i, j ) = 1.d0 / dble( i+j )
106 t( i, j ) = 1.d0 / dble( i+j )
107 END DO
108 w( j ) = 0.d0
109 END DO
110 ok = .true.
111*
112* Error exits for TS factorization
113*
114* DGEQR
115*
116 srnamt = 'DGEQR'
117 infot = 1
118 CALL dgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
119 CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
120 infot = 2
121 CALL dgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
122 CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
123 infot = 4
124 CALL dgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
125 CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
126 infot = 6
127 CALL dgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
128 CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
129 infot = 8
130 CALL dgeqr( 3, 2, a, 3, tau, 7, w, 0, info )
131 CALL chkxer( 'DGEQR', infot, nout, lerr, ok )
132*
133* DLATSQR
134*
135 mb = 1
136 nb = 1
137 srnamt = 'DLATSQR'
138 infot = 1
139 CALL dlatsqr( -1, 0, mb, nb, a, 1, tau, 1, w, 1, info )
140 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
141 infot = 2
142 CALL dlatsqr( 1, 2, mb, nb, a, 1, tau, 1, w, 1, info )
143 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
144 CALL dlatsqr( 0, -1, mb, nb, a, 1, tau, 1, w, 1, info )
145 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
146 infot = 3
147 CALL dlatsqr( 2, 1, -1, nb, a, 2, tau, 1, w, 1, info )
148 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
149 infot = 4
150 CALL dlatsqr( 2, 1, mb, 2, a, 2, tau, 1, w, 1, info )
151 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
152 infot = 6
153 CALL dlatsqr( 2, 1, mb, nb, a, 1, tau, 1, w, 1, info )
154 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
155 infot = 8
156 CALL dlatsqr( 2, 1, mb, nb, a, 2, tau, 0, w, 1, info )
157 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
158 infot = 10
159 CALL dlatsqr( 2, 1, mb, nb, a, 2, tau, 2, w, 0, info )
160 CALL chkxer( 'DLATSQR', infot, nout, lerr, ok )
161*
162* DGEMQR
163*
164 tau(1)=1
165 tau(2)=1
166 tau(3)=1
167 tau(4)=1
168 srnamt = 'DGEMQR'
169 nb=1
170 infot = 1
171 CALL dgemqr( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
172 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
173 infot = 2
174 CALL dgemqr( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
175 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
176 infot = 3
177 CALL dgemqr( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
178 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
179 infot = 4
180 CALL dgemqr( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
181 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
182 infot = 5
183 CALL dgemqr( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
184 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
185 infot = 5
186 CALL dgemqr( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
187 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
188 infot = 7
189 CALL dgemqr( 'L', 'N', 2, 1, 0, a, 0, tau, 1, c, 1, w, 1,info)
190 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
191 infot = 9
192 CALL dgemqr( 'R', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
193 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
194 infot = 9
195 CALL dgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
196 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
197 infot = 11
198 CALL dgemqr( 'L', 'N', 2, 1, 1, a, 2, tau, 6, c, 0, w, 1,info)
199 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
200 infot = 13
201 CALL dgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
202 CALL chkxer( 'DGEMQR', infot, nout, lerr, ok )
203*
204* DGELQ
205*
206 srnamt = 'DGELQ'
207 infot = 1
208 CALL dgelq( -1, 0, a, 1, tau, 1, w, 1, info )
209 CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
210 infot = 2
211 CALL dgelq( 0, -1, a, 1, tau, 1, w, 1, info )
212 CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
213 infot = 4
214 CALL dgelq( 1, 1, a, 0, tau, 1, w, 1, info )
215 CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
216 infot = 6
217 CALL dgelq( 2, 3, a, 3, tau, 1, w, 1, info )
218 CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
219 infot = 8
220 CALL dgelq( 2, 3, a, 3, tau, 7, w, 0, info )
221 CALL chkxer( 'DGELQ', infot, nout, lerr, ok )
222*
223* DLASWLQ
224*
225 mb = 1
226 nb = 1
227 srnamt = 'DLASWLQ'
228 infot = 1
229 CALL dlaswlq( -1, 0, mb, nb, a, 1, tau, 1, w, 1, info )
230 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
231 infot = 2
232 CALL dlaswlq( 2, 1, mb, nb, a, 1, tau, 1, w, 1, info )
233 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
234 CALL dlaswlq( 0, -1, mb, nb, a, 1, tau, 1, w, 1, info )
235 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
236 infot = 3
237 CALL dlaswlq( 1, 2, -1, nb, a, 1, tau, 1, w, 1, info )
238 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
239 CALL dlaswlq( 1, 1, 2, nb, a, 1, tau, 1, w, 1, info )
240 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
241 infot = 4
242 CALL dlaswlq( 1, 2, mb, -1, a, 1, tau, 1, w, 1, info )
243 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
244 infot = 6
245 CALL dlaswlq( 1, 2, mb, nb, a, 0, tau, 1, w, 1, info )
246 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
247 infot = 8
248 CALL dlaswlq( 1, 2, mb, nb, a, 1, tau, 0, w, 1, info )
249 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
250 infot = 10
251 CALL dlaswlq( 1, 2, mb, nb, a, 1, tau, 1, w, 0, info )
252 CALL chkxer( 'DLASWLQ', infot, nout, lerr, ok )
253*
254* DGEMLQ
255*
256 tau(1)=1
257 tau(2)=1
258 srnamt = 'DGEMLQ'
259 nb=1
260 infot = 1
261 CALL dgemlq( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
262 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
263 infot = 2
264 CALL dgemlq( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
265 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
266 infot = 3
267 CALL dgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
268 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
269 infot = 4
270 CALL dgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
271 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
272 infot = 5
273 CALL dgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
274 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
275 infot = 5
276 CALL dgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
277 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
278 infot = 7
279 CALL dgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
280 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
281 infot = 9
282 CALL dgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
283 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
284 infot = 9
285 CALL dgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
286 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
287 infot = 11
288 CALL dgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
289 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
290 infot = 13
291 CALL dgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
292 CALL chkxer( 'DGEMLQ', infot, nout, lerr, ok )
293*
294* Print a summary line.
295*
296 CALL alaesm( path, ok, nout )
297*
298 RETURN
299*
300* End of DERRTSQR
301*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
dgelq
subroutine dgelq(m, n, a, lda, t, tsize, work, lwork, info)
DGELQ
Definition dgelq.f:174
dgemlq
subroutine dgemlq(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
DGEMLQ
Definition dgemlq.f:173
dgemqr
subroutine dgemqr(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
DGEMQR
Definition dgemqr.f:174
dgeqr
subroutine dgeqr(m, n, a, lda, t, tsize, work, lwork, info)
DGEQR
Definition dgeqr.f:176
dlaswlq
subroutine dlaswlq(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
DLASWLQ
Definition dlaswlq.f:167
dlatsqr
subroutine dlatsqr(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
DLATSQR
Definition dlatsqr.f:169
Here is the call graph for this function:
Here is the caller graph for this function: