LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cerrunhr_col.f
Go to the documentation of this file.
1 *> \brief \b CERRUNHR_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 CERRUNHR_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 *> CERRUNHR_COL tests the error exits for CUNHR_COL that does
25 *> Householder reconstruction from the output of tall-skinny
26 *> factorization CLATSQR.
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 *> \ingroup complex_lin
53 *
54 * =====================================================================
55  SUBROUTINE cerrunhr_col( PATH, NUNIT )
56  IMPLICIT NONE
57 *
58 * -- LAPACK test routine --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 *
62 * .. Scalar Arguments ..
63  CHARACTER(LEN=3) PATH
64  INTEGER NUNIT
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  INTEGER NMAX
71  parameter( nmax = 2 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER I, INFO, J
75 * ..
76 * .. Local Arrays ..
77  COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX)
78 * ..
79 * .. External Subroutines ..
80  EXTERNAL alaesm, chkxer, cunhr_col
81 * ..
82 * .. Scalars in Common ..
83  LOGICAL LERR, OK
84  CHARACTER(LEN=32) SRNAMT
85  INTEGER INFOT, NOUT
86 * ..
87 * .. Common blocks ..
88  COMMON / infoc / infot, nout, ok, lerr
89  COMMON / srnamc / srnamt
90 * ..
91 * .. Intrinsic Functions ..
92  INTRINSIC real, cmplx
93 * ..
94 * .. Executable Statements ..
95 *
96  nout = nunit
97  WRITE( nout, fmt = * )
98 *
99 * Set the variables to innocuous values.
100 *
101  DO j = 1, nmax
102  DO i = 1, nmax
103  a( i, j ) = cmplx( 1.e+0 / real( i+j ) )
104  t( i, j ) = cmplx( 1.e+0 / real( i+j ) )
105  END DO
106  d( j ) = ( 0.e+0, 0.e+0 )
107  END DO
108  ok = .true.
109 *
110 * Error exits for Householder reconstruction
111 *
112 * CUNHR_COL
113 *
114  srnamt = 'CUNHR_COL'
115 *
116  infot = 1
117  CALL cunhr_col( -1, 0, 1, a, 1, t, 1, d, info )
118  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
119 *
120  infot = 2
121  CALL cunhr_col( 0, -1, 1, a, 1, t, 1, d, info )
122  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
123  CALL cunhr_col( 1, 2, 1, a, 1, t, 1, d, info )
124  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
125 *
126  infot = 3
127  CALL cunhr_col( 0, 0, -1, a, 1, t, 1, d, info )
128  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
129 *
130  CALL cunhr_col( 0, 0, 0, a, 1, t, 1, d, info )
131  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
132 *
133  infot = 5
134  CALL cunhr_col( 0, 0, 1, a, -1, t, 1, d, info )
135  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
136 *
137  CALL cunhr_col( 0, 0, 1, a, 0, t, 1, d, info )
138  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
139 *
140  CALL cunhr_col( 2, 0, 1, a, 1, t, 1, d, info )
141  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
142 *
143  infot = 7
144  CALL cunhr_col( 0, 0, 1, a, 1, t, -1, d, info )
145  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
146 *
147  CALL cunhr_col( 0, 0, 1, a, 1, t, 0, d, info )
148  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
149 *
150  CALL cunhr_col( 4, 3, 2, a, 4, t, 1, d, info )
151  CALL chkxer( 'CUNHR_COL', infot, nout, lerr, ok )
152 *
153 * Print a summary line.
154 *
155  CALL alaesm( path, ok, nout )
156 *
157  RETURN
158 *
159 * End of CERRUNHR_COL
160 *
161  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cerrunhr_col(PATH, NUNIT)
CERRUNHR_COL
Definition: cerrunhr_col.f:56
subroutine cunhr_col(M, N, NB, A, LDA, T, LDT, D, INFO)
CUNHR_COL
Definition: cunhr_col.f:259