LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ derred()

subroutine derred ( character*3  PATH,
integer  NUNIT 
)

DERRED

Purpose:
 DERRED tests the error exits for the eigenvalue driver routines for
 DOUBLE PRECISION matrices:

 PATH  driver   description
 ----  ------   -----------
 SEV   DGEEV    find eigenvalues/eigenvectors for nonsymmetric A
 SES   DGEES    find eigenvalues/Schur form for nonsymmetric A
 SVX   DGEEVX   SGEEV + balancing and condition estimation
 SSX   DGEESX   SGEES + balancing and condition estimation
 DBD   DGESVD   compute SVD of an M-by-N matrix A
       DGESDD   compute SVD of an M-by-N matrix A (by divide and
                conquer)
       DGEJSV   compute SVD of an M-by-N matrix A where M >= N
       DGESVDX  compute SVD of an M-by-N matrix A(by bisection
                and inverse iteration)
       DGESVDQ  compute SVD of an M-by-N matrix A(with a 
                QR-Preconditioned )
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.
Date
June 2016

Definition at line 72 of file derred.f.

72 *
73 * -- LAPACK test routine (version 3.7.0) --
74 * -- LAPACK is a software package provided by Univ. of Tennessee, --
75 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
76 * June 2016
77 *
78 * .. Scalar Arguments ..
79  CHARACTER*3 PATH
80  INTEGER NUNIT
81 * ..
82 *
83 * =====================================================================
84 *
85 * .. Parameters ..
86  INTEGER NMAX
87  DOUBLE PRECISION ONE, ZERO
88  parameter( nmax = 4, one = 1.0d0, zero = 0.0d0 )
89 * ..
90 * .. Local Scalars ..
91  CHARACTER*2 C2
92  INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
93  DOUBLE PRECISION ABNRM
94 * ..
95 * .. Local Arrays ..
96  LOGICAL B( NMAX )
97  INTEGER IW( 2*NMAX )
98  DOUBLE PRECISION A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ),
99  $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ),
100  $ VR( NMAX, NMAX ), VT( NMAX, NMAX ),
101  $ W( 10*NMAX ), WI( NMAX ), WR( NMAX )
102 * ..
103 * .. External Subroutines ..
104  EXTERNAL chkxer, dgees, dgeesx, dgeev, dgeevx, dgejsv,
105  $ dgesdd, dgesvd, dgesvdx, dgesvq
106 * ..
107 * .. External Functions ..
108  LOGICAL DSLECT, LSAMEN
109  EXTERNAL dslect, lsamen
110 * ..
111 * .. Intrinsic Functions ..
112  INTRINSIC len_trim
113 * ..
114 * .. Arrays in Common ..
115  LOGICAL SELVAL( 20 )
116  DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
117 * ..
118 * .. Scalars in Common ..
119  LOGICAL LERR, OK
120  CHARACTER*32 SRNAMT
121  INTEGER INFOT, NOUT, SELDIM, SELOPT
122 * ..
123 * .. Common blocks ..
124  COMMON / infoc / infot, nout, ok, lerr
125  COMMON / srnamc / srnamt
126  COMMON / sslct / selopt, seldim, selval, selwr, selwi
127 * ..
128 * .. Executable Statements ..
129 *
130  nout = nunit
131  WRITE( nout, fmt = * )
132  c2 = path( 2: 3 )
133 *
134 * Initialize A
135 *
136  DO 20 j = 1, nmax
137  DO 10 i = 1, nmax
138  a( i, j ) = zero
139  10 CONTINUE
140  20 CONTINUE
141  DO 30 i = 1, nmax
142  a( i, i ) = one
143  30 CONTINUE
144  ok = .true.
145  nt = 0
146 *
147  IF( lsamen( 2, c2, 'EV' ) ) THEN
148 *
149 * Test DGEEV
150 *
151  srnamt = 'DGEEV '
152  infot = 1
153  CALL dgeev( 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
154  $ info )
155  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
156  infot = 2
157  CALL dgeev( 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
158  $ info )
159  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
160  infot = 3
161  CALL dgeev( 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr, 1, w, 1,
162  $ info )
163  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
164  infot = 5
165  CALL dgeev( 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1, w, 6,
166  $ info )
167  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
168  infot = 9
169  CALL dgeev( 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
170  $ info )
171  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
172  infot = 11
173  CALL dgeev( 'N', 'V', 2, a, 2, wr, wi, vl, 1, vr, 1, w, 8,
174  $ info )
175  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
176  infot = 13
177  CALL dgeev( 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1, w, 3,
178  $ info )
179  CALL chkxer( 'DGEEV ', infot, nout, lerr, ok )
180  nt = nt + 7
181 *
182  ELSE IF( lsamen( 2, c2, 'ES' ) ) THEN
183 *
184 * Test DGEES
185 *
186  srnamt = 'DGEES '
187  infot = 1
188  CALL dgees( 'X', 'N', dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
189  $ 1, b, info )
190  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
191  infot = 2
192  CALL dgees( 'N', 'X', dslect, 0, a, 1, sdim, wr, wi, vl, 1, w,
193  $ 1, b, info )
194  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
195  infot = 4
196  CALL dgees( 'N', 'S', dslect, -1, a, 1, sdim, wr, wi, vl, 1, w,
197  $ 1, b, info )
198  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
199  infot = 6
200  CALL dgees( 'N', 'S', dslect, 2, a, 1, sdim, wr, wi, vl, 1, w,
201  $ 6, b, info )
202  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
203  infot = 11
204  CALL dgees( 'V', 'S', dslect, 2, a, 2, sdim, wr, wi, vl, 1, w,
205  $ 6, b, info )
206  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
207  infot = 13
208  CALL dgees( 'N', 'S', dslect, 1, a, 1, sdim, wr, wi, vl, 1, w,
209  $ 2, b, info )
210  CALL chkxer( 'DGEES ', infot, nout, lerr, ok )
211  nt = nt + 6
212 *
213  ELSE IF( lsamen( 2, c2, 'VX' ) ) THEN
214 *
215 * Test DGEEVX
216 *
217  srnamt = 'DGEEVX'
218  infot = 1
219  CALL dgeevx( 'X', 'N', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
220  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
221  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
222  infot = 2
223  CALL dgeevx( 'N', 'X', 'N', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
224  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
225  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
226  infot = 3
227  CALL dgeevx( 'N', 'N', 'X', 'N', 0, a, 1, wr, wi, vl, 1, vr, 1,
228  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
229  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
230  infot = 4
231  CALL dgeevx( 'N', 'N', 'N', 'X', 0, a, 1, wr, wi, vl, 1, vr, 1,
232  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
233  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
234  infot = 5
235  CALL dgeevx( 'N', 'N', 'N', 'N', -1, a, 1, wr, wi, vl, 1, vr,
236  $ 1, ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
237  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
238  infot = 7
239  CALL dgeevx( 'N', 'N', 'N', 'N', 2, a, 1, wr, wi, vl, 1, vr, 1,
240  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
241  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
242  infot = 11
243  CALL dgeevx( 'N', 'V', 'N', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
244  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
245  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
246  infot = 13
247  CALL dgeevx( 'N', 'N', 'V', 'N', 2, a, 2, wr, wi, vl, 1, vr, 1,
248  $ ilo, ihi, s, abnrm, r1, r2, w, 6, iw, info )
249  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
250  infot = 21
251  CALL dgeevx( 'N', 'N', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
252  $ ilo, ihi, s, abnrm, r1, r2, w, 1, iw, info )
253  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
254  infot = 21
255  CALL dgeevx( 'N', 'V', 'N', 'N', 1, a, 1, wr, wi, vl, 1, vr, 1,
256  $ ilo, ihi, s, abnrm, r1, r2, w, 2, iw, info )
257  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
258  infot = 21
259  CALL dgeevx( 'N', 'N', 'V', 'V', 1, a, 1, wr, wi, vl, 1, vr, 1,
260  $ ilo, ihi, s, abnrm, r1, r2, w, 3, iw, info )
261  CALL chkxer( 'DGEEVX', infot, nout, lerr, ok )
262  nt = nt + 11
263 *
264  ELSE IF( lsamen( 2, c2, 'SX' ) ) THEN
265 *
266 * Test DGEESX
267 *
268  srnamt = 'DGEESX'
269  infot = 1
270  CALL dgeesx( 'X', 'N', dslect, 'N', 0, a, 1, sdim, wr, wi, vl,
271  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
272  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
273  infot = 2
274  CALL dgeesx( 'N', 'X', dslect, 'N', 0, a, 1, sdim, wr, wi, vl,
275  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
276  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
277  infot = 4
278  CALL dgeesx( 'N', 'N', dslect, 'X', 0, a, 1, sdim, wr, wi, vl,
279  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
280  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
281  infot = 5
282  CALL dgeesx( 'N', 'N', dslect, 'N', -1, a, 1, sdim, wr, wi, vl,
283  $ 1, r1( 1 ), r2( 1 ), w, 1, iw, 1, b, info )
284  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
285  infot = 7
286  CALL dgeesx( 'N', 'N', dslect, 'N', 2, a, 1, sdim, wr, wi, vl,
287  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
288  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
289  infot = 12
290  CALL dgeesx( 'V', 'N', dslect, 'N', 2, a, 2, sdim, wr, wi, vl,
291  $ 1, r1( 1 ), r2( 1 ), w, 6, iw, 1, b, info )
292  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
293  infot = 16
294  CALL dgeesx( 'N', 'N', dslect, 'N', 1, a, 1, sdim, wr, wi, vl,
295  $ 1, r1( 1 ), r2( 1 ), w, 2, iw, 1, b, info )
296  CALL chkxer( 'DGEESX', infot, nout, lerr, ok )
297  nt = nt + 7
298 *
299  ELSE IF( lsamen( 2, c2, 'BD' ) ) THEN
300 *
301 * Test DGESVD
302 *
303  srnamt = 'DGESVD'
304  infot = 1
305  CALL dgesvd( 'X', 'N', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
306  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
307  infot = 2
308  CALL dgesvd( 'N', 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
309  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
310  infot = 2
311  CALL dgesvd( 'O', 'O', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, info )
312  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
313  infot = 3
314  CALL dgesvd( 'N', 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1,
315  $ info )
316  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
317  infot = 4
318  CALL dgesvd( 'N', 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1,
319  $ info )
320  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
321  infot = 6
322  CALL dgesvd( 'N', 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, info )
323  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
324  infot = 9
325  CALL dgesvd( 'A', 'N', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, info )
326  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
327  infot = 11
328  CALL dgesvd( 'N', 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, info )
329  CALL chkxer( 'DGESVD', infot, nout, lerr, ok )
330  nt = 8
331  IF( ok ) THEN
332  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
333  $ nt
334  ELSE
335  WRITE( nout, fmt = 9998 )
336  END IF
337 *
338 * Test DGESDD
339 *
340  srnamt = 'DGESDD'
341  infot = 1
342  CALL dgesdd( 'X', 0, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
343  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
344  infot = 2
345  CALL dgesdd( 'N', -1, 0, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
346  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
347  infot = 3
348  CALL dgesdd( 'N', 0, -1, a, 1, s, u, 1, vt, 1, w, 1, iw, info )
349  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
350  infot = 5
351  CALL dgesdd( 'N', 2, 1, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
352  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
353  infot = 8
354  CALL dgesdd( 'A', 2, 1, a, 2, s, u, 1, vt, 1, w, 5, iw, info )
355  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
356  infot = 10
357  CALL dgesdd( 'A', 1, 2, a, 1, s, u, 1, vt, 1, w, 5, iw, info )
358  CALL chkxer( 'DGESDD', infot, nout, lerr, ok )
359  nt = 6
360  IF( ok ) THEN
361  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
362  $ nt
363  ELSE
364  WRITE( nout, fmt = 9998 )
365  END IF
366 *
367 * Test DGEJSV
368 *
369  srnamt = 'DGEJSV'
370  infot = 1
371  CALL dgejsv( 'X', 'U', 'V', 'R', 'N', 'N',
372  $ 0, 0, a, 1, s, u, 1, vt, 1,
373  $ w, 1, iw, info)
374  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
375  infot = 2
376  CALL dgejsv( 'G', 'X', 'V', 'R', 'N', 'N',
377  $ 0, 0, a, 1, s, u, 1, vt, 1,
378  $ w, 1, iw, info)
379  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
380  infot = 3
381  CALL dgejsv( 'G', 'U', 'X', 'R', 'N', 'N',
382  $ 0, 0, a, 1, s, u, 1, vt, 1,
383  $ w, 1, iw, info)
384  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
385  infot = 4
386  CALL dgejsv( 'G', 'U', 'V', 'X', 'N', 'N',
387  $ 0, 0, a, 1, s, u, 1, vt, 1,
388  $ w, 1, iw, info)
389  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
390  infot = 5
391  CALL dgejsv( 'G', 'U', 'V', 'R', 'X', 'N',
392  $ 0, 0, a, 1, s, u, 1, vt, 1,
393  $ w, 1, iw, info)
394  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
395  infot = 6
396  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'X',
397  $ 0, 0, a, 1, s, u, 1, vt, 1,
398  $ w, 1, iw, info)
399  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
400  infot = 7
401  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
402  $ -1, 0, a, 1, s, u, 1, vt, 1,
403  $ w, 1, iw, info)
404  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
405  infot = 8
406  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
407  $ 0, -1, a, 1, s, u, 1, vt, 1,
408  $ w, 1, iw, info)
409  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
410  infot = 10
411  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
412  $ 2, 1, a, 1, s, u, 1, vt, 1,
413  $ w, 1, iw, info)
414  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
415  infot = 13
416  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
417  $ 2, 2, a, 2, s, u, 1, vt, 2,
418  $ w, 1, iw, info)
419  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
420  infot = 15
421  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
422  $ 2, 2, a, 2, s, u, 2, vt, 1,
423  $ w, 1, iw, info)
424  CALL chkxer( 'DGEJSV', infot, nout, lerr, ok )
425  nt = 11
426  IF( ok ) THEN
427  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
428  $ nt
429  ELSE
430  WRITE( nout, fmt = 9998 )
431  END IF
432 *
433 * Test DGESVDX
434 *
435  srnamt = 'DGESVDX'
436  infot = 1
437  CALL dgesvdx( 'X', 'N', 'A', 0, 0, a, 1, zero, zero,
438  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
439  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
440  infot = 2
441  CALL dgesvdx( 'N', 'X', 'A', 0, 0, a, 1, zero, zero,
442  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
443  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
444  infot = 3
445  CALL dgesvdx( 'N', 'N', 'X', 0, 0, a, 1, zero, zero,
446  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
447  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
448  infot = 4
449  CALL dgesvdx( 'N', 'N', 'A', -1, 0, a, 1, zero, zero,
450  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
451  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
452  infot = 5
453  CALL dgesvdx( 'N', 'N', 'A', 0, -1, a, 1, zero, zero,
454  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
455  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
456  infot = 7
457  CALL dgesvdx( 'N', 'N', 'A', 2, 1, a, 1, zero, zero,
458  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
459  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
460  infot = 8
461  CALL dgesvdx( 'N', 'N', 'V', 2, 1, a, 2, -one, zero,
462  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
463  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
464  infot = 9
465  CALL dgesvdx( 'N', 'N', 'V', 2, 1, a, 2, one, zero,
466  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
467  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
468  infot = 10
469  CALL dgesvdx( 'N', 'N', 'I', 2, 2, a, 2, zero, zero,
470  $ 0, 1, ns, s, u, 1, vt, 1, w, 1, iw, info )
471  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
472  infot = 11
473  CALL dgesvdx( 'V', 'N', 'I', 2, 2, a, 2, zero, zero,
474  $ 1, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
475  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
476  infot = 15
477  CALL dgesvdx( 'V', 'N', 'A', 2, 2, a, 2, zero, zero,
478  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
479  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
480  infot = 17
481  CALL dgesvdx( 'N', 'V', 'A', 2, 2, a, 2, zero, zero,
482  $ 0, 0, ns, s, u, 1, vt, 1, w, 1, iw, info )
483  CALL chkxer( 'DGESVDX', infot, nout, lerr, ok )
484  nt = 12
485  IF( ok ) THEN
486  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
487  $ nt
488  ELSE
489  WRITE( nout, fmt = 9998 )
490  END IF
491 *
492 * Test DGESVDQ
493 *
494  srnamt = 'DGESVDQ'
495  infot = 1
496  CALL dgesvdq( 'X', 'P', 'T', 'A', 'A', 0, 0, a, 1, s, u,
497  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
498  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
499  infot = 2
500  CALL dgesvdq( 'A', 'X', 'T', 'A', 'A', 0, 0, a, 1, s, u,
501  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
502  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
503  infot = 3
504  CALL dgesvdq( 'A', 'P', 'X', 'A', 'A', 0, 0, a, 1, s, u,
505  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
506  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
507  infot = 4
508  CALL dgesvdq( 'A', 'P', 'T', 'X', 'A', 0, 0, a, 1, s, u,
509  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
510  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
511  infot = 5
512  CALL dgesvdq( 'A', 'P', 'T', 'A', 'X', 0, 0, a, 1, s, u,
513  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
514  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
515  infot = 6
516  CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', -1, 0, a, 1, s, u,
517  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
518  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
519  infot = 7
520  CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 0, 1, a, 1, s, u,
521  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
522  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
523  infot = 9
524  CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 0, s, u,
525  $ 0, vt, 0, ns, iw, 1, w, 1, w, 1, info )
526  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
527  infot = 12
528  CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
529  $ -1, vt, 0, ns, iw, 1, w, 1, w, 1, info )
530  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
531  infot = 14
532  CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
533  $ 1, vt, -1, ns, iw, 1, w, 1, w, 1, info )
534  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
535  infot = 17
536  CALL dgesvdq( 'A', 'P', 'T', 'A', 'A', 1, 1, a, 1, s, u,
537  $ 1, vt, 1, ns, iw, -5, w, 1, w, 1, info )
538  CALL chkxer( 'DGESVDQ', infot, nout, lerr, ok )
539  nt = 11
540  IF( ok ) THEN
541  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
542  $ nt
543  ELSE
544  WRITE( nout, fmt = 9998 )
545  END IF
546  END IF
547 *
548 * Print a summary line.
549 *
550  IF( .NOT.lsamen( 2, c2, 'BD' ) ) THEN
551  IF( ok ) THEN
552  WRITE( nout, fmt = 9999 )srnamt( 1:len_trim( srnamt ) ),
553  $ nt
554  ELSE
555  WRITE( nout, fmt = 9998 )
556  END IF
557  END IF
558 *
559  9999 FORMAT( 1x, a, ' passed the tests of the error exits (', i3,
560  $ ' tests done)' )
561  9998 FORMAT( ' *** ', a, ' failed the tests of the error exits ***' )
562  RETURN
563 *
564 * End of DERRED
Here is the call graph for this function:
Here is the caller graph for this function:
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
dgees
subroutine dgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
Definition: dgees.f:218
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dgesdd
subroutine dgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESDD
Definition: dgesdd.f:220
dgeesx
subroutine dgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
Definition: dgeesx.f:283
dgeev
subroutine dgeev(JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition: dgeev.f:193
dgesvd
subroutine dgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
DGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvd.f:213
dgeevx
subroutine dgeevx(BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO)
DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition: dgeevx.f:307
dslect
logical function dslect(ZR, ZI)
DSLECT
Definition: dslect.f:64
dgesvdq
subroutine dgesvdq(JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, WORK, LWORK, RWORK, LRWORK, INFO)
DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition: dgesvdq.f:417
dgesvdx
subroutine dgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvdx.f:265
dgejsv
subroutine dgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, WORK, LWORK, IWORK, INFO)
DGEJSV
Definition: dgejsv.f:478