LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ derrge()

subroutine derrge ( character*3  PATH,
integer  NUNIT 
)

DERRGE

DERRGEX

Purpose:
 DERRGE tests the error exits for the DOUBLE PRECISION routines
 for general matrices.
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
December 2016
Purpose:
 DERRGE tests the error exits for the DOUBLE PRECISION routines
 for general matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise derrge.f defines this subroutine.
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
December 2016

Definition at line 57 of file derrge.f.

57 *
58 * -- LAPACK test routine (version 3.7.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * December 2016
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX, LW
72  parameter( nmax = 4, lw = 3*nmax )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 C2
76  INTEGER I, INFO, J
77  DOUBLE PRECISION ANRM, CCOND, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IP( NMAX ), IW( NMAX )
81  DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
82  $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX )
83 * ..
84 * .. External Functions ..
85  LOGICAL LSAMEN
86  EXTERNAL lsamen
87 * ..
88 * .. External Subroutines ..
89  EXTERNAL alaesm, chkxer, dgbcon, dgbequ, dgbrfs, dgbtf2,
90  $ dgbtrf, dgbtrs, dgecon, dgeequ, dgerfs, dgetf2,
91  $ dgetrf, dgetri, dgetrs
92 * ..
93 * .. Scalars in Common ..
94  LOGICAL LERR, OK
95  CHARACTER*32 SRNAMT
96  INTEGER INFOT, NOUT
97 * ..
98 * .. Common blocks ..
99  COMMON / infoc / infot, nout, ok, lerr
100  COMMON / srnamc / srnamt
101 * ..
102 * .. Intrinsic Functions ..
103  INTRINSIC dble
104 * ..
105 * .. Executable Statements ..
106 *
107  nout = nunit
108  WRITE( nout, fmt = * )
109  c2 = path( 2: 3 )
110 *
111 * Set the variables to innocuous values.
112 *
113  DO 20 j = 1, nmax
114  DO 10 i = 1, nmax
115  a( i, j ) = 1.d0 / dble( i+j )
116  af( i, j ) = 1.d0 / dble( i+j )
117  10 CONTINUE
118  b( j ) = 0.d0
119  r1( j ) = 0.d0
120  r2( j ) = 0.d0
121  w( j ) = 0.d0
122  x( j ) = 0.d0
123  ip( j ) = j
124  iw( j ) = j
125  20 CONTINUE
126  ok = .true.
127 *
128  IF( lsamen( 2, c2, 'GE' ) ) THEN
129 *
130 * Test error exits of the routines that use the LU decomposition
131 * of a general matrix.
132 *
133 * DGETRF
134 *
135  srnamt = 'DGETRF'
136  infot = 1
137  CALL dgetrf( -1, 0, a, 1, ip, info )
138  CALL chkxer( 'DGETRF', infot, nout, lerr, ok )
139  infot = 2
140  CALL dgetrf( 0, -1, a, 1, ip, info )
141  CALL chkxer( 'DGETRF', infot, nout, lerr, ok )
142  infot = 4
143  CALL dgetrf( 2, 1, a, 1, ip, info )
144  CALL chkxer( 'DGETRF', infot, nout, lerr, ok )
145 *
146 * DGETF2
147 *
148  srnamt = 'DGETF2'
149  infot = 1
150  CALL dgetf2( -1, 0, a, 1, ip, info )
151  CALL chkxer( 'DGETF2', infot, nout, lerr, ok )
152  infot = 2
153  CALL dgetf2( 0, -1, a, 1, ip, info )
154  CALL chkxer( 'DGETF2', infot, nout, lerr, ok )
155  infot = 4
156  CALL dgetf2( 2, 1, a, 1, ip, info )
157  CALL chkxer( 'DGETF2', infot, nout, lerr, ok )
158 *
159 * DGETRI
160 *
161  srnamt = 'DGETRI'
162  infot = 1
163  CALL dgetri( -1, a, 1, ip, w, lw, info )
164  CALL chkxer( 'DGETRI', infot, nout, lerr, ok )
165  infot = 3
166  CALL dgetri( 2, a, 1, ip, w, lw, info )
167  CALL chkxer( 'DGETRI', infot, nout, lerr, ok )
168 *
169 * DGETRS
170 *
171  srnamt = 'DGETRS'
172  infot = 1
173  CALL dgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
174  CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
175  infot = 2
176  CALL dgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
177  CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
178  infot = 3
179  CALL dgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
180  CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
181  infot = 5
182  CALL dgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
183  CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
184  infot = 8
185  CALL dgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
186  CALL chkxer( 'DGETRS', infot, nout, lerr, ok )
187 *
188 * DGERFS
189 *
190  srnamt = 'DGERFS'
191  infot = 1
192  CALL dgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
193  $ iw, info )
194  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
195  infot = 2
196  CALL dgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
197  $ w, iw, info )
198  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
199  infot = 3
200  CALL dgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
201  $ w, iw, info )
202  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
203  infot = 5
204  CALL dgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
205  $ iw, info )
206  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
207  infot = 7
208  CALL dgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
209  $ iw, info )
210  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
211  infot = 10
212  CALL dgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
213  $ iw, info )
214  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
215  infot = 12
216  CALL dgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
217  $ iw, info )
218  CALL chkxer( 'DGERFS', infot, nout, lerr, ok )
219 *
220 * DGECON
221 *
222  srnamt = 'DGECON'
223  infot = 1
224  CALL dgecon( '/', 0, a, 1, anrm, rcond, w, iw, info )
225  CALL chkxer( 'DGECON', infot, nout, lerr, ok )
226  infot = 2
227  CALL dgecon( '1', -1, a, 1, anrm, rcond, w, iw, info )
228  CALL chkxer( 'DGECON', infot, nout, lerr, ok )
229  infot = 4
230  CALL dgecon( '1', 2, a, 1, anrm, rcond, w, iw, info )
231  CALL chkxer( 'DGECON', infot, nout, lerr, ok )
232 *
233 * DGEEQU
234 *
235  srnamt = 'DGEEQU'
236  infot = 1
237  CALL dgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
238  CALL chkxer( 'DGEEQU', infot, nout, lerr, ok )
239  infot = 2
240  CALL dgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
241  CALL chkxer( 'DGEEQU', infot, nout, lerr, ok )
242  infot = 4
243  CALL dgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
244  CALL chkxer( 'DGEEQU', infot, nout, lerr, ok )
245 *
246  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
247 *
248 * Test error exits of the routines that use the LU decomposition
249 * of a general band matrix.
250 *
251 * DGBTRF
252 *
253  srnamt = 'DGBTRF'
254  infot = 1
255  CALL dgbtrf( -1, 0, 0, 0, a, 1, ip, info )
256  CALL chkxer( 'DGBTRF', infot, nout, lerr, ok )
257  infot = 2
258  CALL dgbtrf( 0, -1, 0, 0, a, 1, ip, info )
259  CALL chkxer( 'DGBTRF', infot, nout, lerr, ok )
260  infot = 3
261  CALL dgbtrf( 1, 1, -1, 0, a, 1, ip, info )
262  CALL chkxer( 'DGBTRF', infot, nout, lerr, ok )
263  infot = 4
264  CALL dgbtrf( 1, 1, 0, -1, a, 1, ip, info )
265  CALL chkxer( 'DGBTRF', infot, nout, lerr, ok )
266  infot = 6
267  CALL dgbtrf( 2, 2, 1, 1, a, 3, ip, info )
268  CALL chkxer( 'DGBTRF', infot, nout, lerr, ok )
269 *
270 * DGBTF2
271 *
272  srnamt = 'DGBTF2'
273  infot = 1
274  CALL dgbtf2( -1, 0, 0, 0, a, 1, ip, info )
275  CALL chkxer( 'DGBTF2', infot, nout, lerr, ok )
276  infot = 2
277  CALL dgbtf2( 0, -1, 0, 0, a, 1, ip, info )
278  CALL chkxer( 'DGBTF2', infot, nout, lerr, ok )
279  infot = 3
280  CALL dgbtf2( 1, 1, -1, 0, a, 1, ip, info )
281  CALL chkxer( 'DGBTF2', infot, nout, lerr, ok )
282  infot = 4
283  CALL dgbtf2( 1, 1, 0, -1, a, 1, ip, info )
284  CALL chkxer( 'DGBTF2', infot, nout, lerr, ok )
285  infot = 6
286  CALL dgbtf2( 2, 2, 1, 1, a, 3, ip, info )
287  CALL chkxer( 'DGBTF2', infot, nout, lerr, ok )
288 *
289 * DGBTRS
290 *
291  srnamt = 'DGBTRS'
292  infot = 1
293  CALL dgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
294  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
295  infot = 2
296  CALL dgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
297  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
298  infot = 3
299  CALL dgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
300  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
301  infot = 4
302  CALL dgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
303  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
304  infot = 5
305  CALL dgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
306  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
307  infot = 7
308  CALL dgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
309  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
310  infot = 10
311  CALL dgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
312  CALL chkxer( 'DGBTRS', infot, nout, lerr, ok )
313 *
314 * DGBRFS
315 *
316  srnamt = 'DGBRFS'
317  infot = 1
318  CALL dgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
319  $ r2, w, iw, info )
320  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
321  infot = 2
322  CALL dgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
323  $ r2, w, iw, info )
324  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
325  infot = 3
326  CALL dgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
327  $ r2, w, iw, info )
328  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
329  infot = 4
330  CALL dgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
331  $ r2, w, iw, info )
332  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
333  infot = 5
334  CALL dgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
335  $ r2, w, iw, info )
336  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
337  infot = 7
338  CALL dgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
339  $ r2, w, iw, info )
340  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
341  infot = 9
342  CALL dgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
343  $ r2, w, iw, info )
344  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
345  infot = 12
346  CALL dgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
347  $ r2, w, iw, info )
348  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
349  infot = 14
350  CALL dgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
351  $ r2, w, iw, info )
352  CALL chkxer( 'DGBRFS', infot, nout, lerr, ok )
353 *
354 * DGBCON
355 *
356  srnamt = 'DGBCON'
357  infot = 1
358  CALL dgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
359  CALL chkxer( 'DGBCON', infot, nout, lerr, ok )
360  infot = 2
361  CALL dgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
362  $ info )
363  CALL chkxer( 'DGBCON', infot, nout, lerr, ok )
364  infot = 3
365  CALL dgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
366  $ info )
367  CALL chkxer( 'DGBCON', infot, nout, lerr, ok )
368  infot = 4
369  CALL dgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
370  $ info )
371  CALL chkxer( 'DGBCON', infot, nout, lerr, ok )
372  infot = 6
373  CALL dgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
374  CALL chkxer( 'DGBCON', infot, nout, lerr, ok )
375 *
376 * DGBEQU
377 *
378  srnamt = 'DGBEQU'
379  infot = 1
380  CALL dgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
381  $ info )
382  CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
383  infot = 2
384  CALL dgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
385  $ info )
386  CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
387  infot = 3
388  CALL dgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
389  $ info )
390  CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
391  infot = 4
392  CALL dgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
393  $ info )
394  CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
395  infot = 6
396  CALL dgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
397  $ info )
398  CALL chkxer( 'DGBEQU', infot, nout, lerr, ok )
399  END IF
400 *
401 * Print a summary line.
402 *
403  CALL alaesm( path, ok, nout )
404 *
405  RETURN
406 *
407 * End of DERRGE
408 *
Here is the call graph for this function:
Here is the caller graph for this function:
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
dgbtrf
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
Definition: dgbtrf.f:146
dgbtrs
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
Definition: dgbtrs.f:140
dgeequ
subroutine dgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQU
Definition: dgeequ.f:141
dgbrfs
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS
Definition: dgbrfs.f:207
dgecon
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
Definition: dgecon.f:126
dgbequ
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
Definition: dgbequ.f:155
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dgetrs
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
Definition: dgetrs.f:123
dgbtf2
subroutine dgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
Definition: dgbtf2.f:147
dgetrf
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
Definition: dgetrf.f:110
dgbcon
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
Definition: dgbcon.f:148
dgetri
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
Definition: dgetri.f:116
dgetf2
subroutine dgetf2(M, N, A, LDA, IPIV, INFO)
DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
Definition: dgetf2.f:110
dgerfs
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
Definition: dgerfs.f:187