1*> \brief \b DERRAB
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE DERRAB( NUNIT )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            NUNIT
15*       ..
16*
17*
18*> \par Purpose:
19*  =============
20*>
21*> \verbatim
22*>
23*> DERRAB tests the error exits for DSGESV.
24*> \endverbatim
25*
26*  Arguments:
27*  ==========
28*
29*> \param[in] NUNIT
30*> \verbatim
31*>          NUNIT is INTEGER
32*>          The unit number for output.
33*> \endverbatim
34*
35*  Authors:
36*  ========
37*
38*> \author Univ. of Tennessee
39*> \author Univ. of California Berkeley
40*> \author Univ. of Colorado Denver
41*> \author NAG Ltd.
42*
43*> \date December 2016
44*
45*> \ingroup double_lin
46*
47*  =====================================================================
48      SUBROUTINE DERRAB( NUNIT )
49*
50*  -- LAPACK test routine (version 3.7.0) --
51*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
52*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
53*     December 2016
54*
55*     .. Scalar Arguments ..
56      INTEGER            NUNIT
57*     ..
58*
59*  =====================================================================
60*
61*     .. Parameters ..
62      INTEGER            NMAX
63      PARAMETER          ( NMAX = 4 )
64*     ..
65*     .. Local Scalars ..
66      INTEGER            I, INFO, ITER, J
67*     ..
68*     .. Local Arrays ..
69      INTEGER            IP( NMAX )
70      DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
71     $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
72     $                   W( 2*NMAX ), X( NMAX )
73      DOUBLE PRECISION   WORK(1)
74      REAL               SWORK(1)
75*     ..
76*     .. External Subroutines ..
77      EXTERNAL           CHKXER, DSGESV
78*     ..
79*     .. Scalars in Common ..
80      LOGICAL            LERR, OK
81      CHARACTER*32       SRNAMT
82      INTEGER            INFOT, NOUT
83*     ..
84*     .. Common blocks ..
85      COMMON             / INFOC / INFOT, NOUT, OK, LERR
86      COMMON             / SRNAMC / SRNAMT
87*     ..
88*     .. Intrinsic Functions ..
89      INTRINSIC          DBLE
90*     ..
91*     .. Executable Statements ..
92*
93      NOUT = NUNIT
94      WRITE( NOUT, FMT = * )
95*
96*     Set the variables to innocuous values.
97*
98      DO 20 J = 1, NMAX
99         DO 10 I = 1, NMAX
100            A( I, J ) = 1.D0 / DBLE( I+J )
101            AF( I, J ) = 1.D0 / DBLE( I+J )
102   10    CONTINUE
103         B( J ) = 0.D0
104         R1( J ) = 0.D0
105         R2( J ) = 0.D0
106         W( J ) = 0.D0
107         X( J ) = 0.D0
108         C( J ) = 0.D0
109         R( J ) = 0.D0
110         IP( J ) = J
111   20 CONTINUE
112      OK = .TRUE.
113*
114      SRNAMT = 'DSGESV'
115      INFOT = 1
116      CALL DSGESV(-1,0,A,1,IP,B,1,X,1,WORK,SWORK,ITER,INFO)
117      CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK )
118      INFOT = 2
119      CALL DSGESV(0,-1,A,1,IP,B,1,X,1,WORK,SWORK,ITER,INFO)
120      CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK )
121      INFOT = 4
122      CALL DSGESV(2,1,A,1,IP,B,2,X,2,WORK,SWORK,ITER,INFO)
123      CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK )
124      INFOT = 7
125      CALL DSGESV(2,1,A,2,IP,B,1,X,2,WORK,SWORK,ITER,INFO)
126      CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK )
127      INFOT = 9
128      CALL DSGESV(2,1,A,2,IP,B,2,X,1,WORK,SWORK,ITER,INFO)
129      CALL CHKXER( 'DSGESV', INFOT, NOUT, LERR, OK )
130*
131*     Print a summary line.
132*
133      IF( OK ) THEN
134         WRITE( NOUT, FMT = 9999 )'DSGESV'
135      ELSE
136         WRITE( NOUT, FMT = 9998 )'DSGESV'
137      END IF
138*
139 9999 FORMAT( 1X, A6, ' drivers passed the tests of the error exits' )
140 9998 FORMAT( ' *** ', A6, ' drivers failed the tests of the error ',
141     $      'exits ***' )
142*
143      RETURN
144*
145*     End of DERRAB
146*
147      END
148