1*> \brief \b DERRLS
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 DERRLS( PATH, NUNIT )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER*3        PATH
15*       INTEGER            NUNIT
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> DERRLS tests the error exits for the DOUBLE PRECISION least squares
25*> driver routines (DGELS, SGELSS, SGELSY, SGELSD).
26*> \endverbatim
27*
28*  Arguments:
29*  ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*>          PATH is CHARACTER*3
34*>          The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*>          NUNIT is INTEGER
40*>          The unit number for output.
41*> \endverbatim
42*
43*  Authors:
44*  ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup double_lin
52*
53*  =====================================================================
54      SUBROUTINE DERRLS( PATH, NUNIT )
55*
56*  -- LAPACK test routine --
57*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
58*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60*     .. Scalar Arguments ..
61      CHARACTER*3        PATH
62      INTEGER            NUNIT
63*     ..
64*
65*  =====================================================================
66*
67*     .. Parameters ..
68      INTEGER            NMAX
69      PARAMETER          ( NMAX = 2 )
70*     ..
71*     .. Local Scalars ..
72      CHARACTER*2        C2
73      INTEGER            INFO, IRNK
74      DOUBLE PRECISION   RCOND
75*     ..
76*     .. Local Arrays ..
77      INTEGER            IP( NMAX )
78      DOUBLE PRECISION   A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ),
79     $                   W( NMAX )
80*     ..
81*     .. External Functions ..
82      LOGICAL            LSAMEN
83      EXTERNAL           LSAMEN
84*     ..
85*     .. External Subroutines ..
86      EXTERNAL           ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELSY
87*     ..
88*     .. Scalars in Common ..
89      LOGICAL            LERR, OK
90      CHARACTER*32       SRNAMT
91      INTEGER            INFOT, NOUT
92*     ..
93*     .. Common blocks ..
94      COMMON             / INFOC / INFOT, NOUT, OK, LERR
95      COMMON             / SRNAMC / SRNAMT
96*     ..
97*     .. Executable Statements ..
98*
99      NOUT = NUNIT
100      WRITE( NOUT, FMT = * )
101      C2 = PATH( 2: 3 )
102      A( 1, 1 ) = 1.0D+0
103      A( 1, 2 ) = 2.0D+0
104      A( 2, 2 ) = 3.0D+0
105      A( 2, 1 ) = 4.0D+0
106      OK = .TRUE.
107*
108      IF( LSAMEN( 2, C2, 'LS' ) ) THEN
109*
110*        Test error exits for the least squares driver routines.
111*
112*        DGELS
113*
114         SRNAMT = 'DGELS '
115         INFOT = 1
116         CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
117         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
118         INFOT = 2
119         CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
120         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
121         INFOT = 3
122         CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
123         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
124         INFOT = 4
125         CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
126         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
127         INFOT = 6
128         CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
129         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
130         INFOT = 8
131         CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
132         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
133         INFOT = 10
134         CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
135         CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
136*
137*        DGELSS
138*
139         SRNAMT = 'DGELSS'
140         INFOT = 1
141         CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
142         CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
143         INFOT = 2
144         CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
145         CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
146         INFOT = 3
147         CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
148         CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
149         INFOT = 5
150         CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
151         CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
152         INFOT = 7
153         CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
154         CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
155*
156*        DGELSY
157*
158         SRNAMT = 'DGELSY'
159         INFOT = 1
160         CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
161     $                INFO )
162         CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
163         INFOT = 2
164         CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
165     $                INFO )
166         CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
167         INFOT = 3
168         CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
169     $                INFO )
170         CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
171         INFOT = 5
172         CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
173     $                INFO )
174         CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
175         INFOT = 7
176         CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
177     $                INFO )
178         CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
179         INFOT = 12
180         CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
181         CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
182*
183*        DGELSD
184*
185         SRNAMT = 'DGELSD'
186         INFOT = 1
187         CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
188     $                INFO )
189         CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
190         INFOT = 2
191         CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
192     $                INFO )
193         CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
194         INFOT = 3
195         CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
196     $                INFO )
197         CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
198         INFOT = 5
199         CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP,
200     $                INFO )
201         CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
202         INFOT = 7
203         CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP,
204     $                INFO )
205         CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
206         INFOT = 12
207         CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
208     $                INFO )
209         CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
210      END IF
211*
212*     Print a summary line.
213*
214      CALL ALAESM( PATH, OK, NOUT )
215*
216      RETURN
217*
218*     End of DERRLS
219*
220      END
221