1*> \brief \b DERRORHR_COL
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 DERRORHR_COL( 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*> DERRORHR_COL tests the error exits for DORHR_COL that does
25*> Householder reconstruction from the ouput of tall-skinny
26*> factorization DLATSQR.
27*> \endverbatim
28*
29*  Arguments:
30*  ==========
31*
32*> \param[in] PATH
33*> \verbatim
34*>          PATH is CHARACTER*3
35*>          The LAPACK path name for the routines to be tested.
36*> \endverbatim
37*>
38*> \param[in] NUNIT
39*> \verbatim
40*>          NUNIT is INTEGER
41*>          The unit number for output.
42*> \endverbatim
43*
44*  Authors:
45*  ========
46*
47*> \author Univ. of Tennessee
48*> \author Univ. of California Berkeley
49*> \author Univ. of Colorado Denver
50*> \author NAG Ltd.
51*
52*> \date November 2019
53*
54*> \ingroup double_lin
55*
56*  =====================================================================
57      SUBROUTINE DERRORHR_COL( PATH, NUNIT )
58      IMPLICIT NONE
59*
60*  -- LAPACK test routine (version 3.9.0) --
61*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
62*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
63*     November 2019
64*
65*     .. Scalar Arguments ..
66      CHARACTER(LEN=3)   PATH
67      INTEGER            NUNIT
68*     ..
69*
70*  =====================================================================
71*
72*     .. Parameters ..
73      INTEGER            NMAX
74      PARAMETER          ( NMAX = 2 )
75*     ..
76*     .. Local Scalars ..
77      INTEGER            I, INFO, J
78*     ..
79*     .. Local Arrays ..
80      DOUBLE PRECISION   A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX)
81*     ..
82*     .. External Subroutines ..
83      EXTERNAL           ALAESM, CHKXER, DORHR_COL
84*     ..
85*     .. Scalars in Common ..
86      LOGICAL            LERR, OK
87      CHARACTER(LEN=32)  SRNAMT
88      INTEGER            INFOT, NOUT
89*     ..
90*     .. Common blocks ..
91      COMMON             / INFOC / INFOT, NOUT, OK, LERR
92      COMMON             / SRNAMC / SRNAMT
93*     ..
94*     .. Intrinsic Functions ..
95      INTRINSIC          DBLE
96*     ..
97*     .. Executable Statements ..
98*
99      NOUT = NUNIT
100      WRITE( NOUT, FMT = * )
101*
102*     Set the variables to innocuous values.
103*
104      DO J = 1, NMAX
105         DO I = 1, NMAX
106            A( I, J ) = 1.D+0 / DBLE( I+J )
107            T( I, J ) = 1.D+0 / DBLE( I+J )
108         END DO
109         D( J ) = 0.D+0
110      END DO
111      OK = .TRUE.
112*
113*     Error exits for Householder reconstruction
114*
115*     DORHR_COL
116*
117      SRNAMT = 'DORHR_COL'
118*
119      INFOT = 1
120      CALL DORHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO )
121      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
122*
123      INFOT = 2
124      CALL DORHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO )
125      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
126      CALL DORHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO )
127      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
128*
129      INFOT = 3
130      CALL DORHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO )
131      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
132*
133      CALL DORHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO )
134      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
135*
136      INFOT = 5
137      CALL DORHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO )
138      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
139*
140      CALL DORHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO )
141      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
142*
143      CALL DORHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO )
144      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
145*
146      INFOT = 7
147      CALL DORHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO )
148      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
149*
150      CALL DORHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO )
151      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
152*
153      CALL DORHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO )
154      CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK )
155*
156*     Print a summary line.
157*
158      CALL ALAESM( PATH, OK, NOUT )
159*
160      RETURN
161*
162*     End of DERRORHR_COL
163*
164      END
165