LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
derrlqtp.f
Go to the documentation of this file.
1 *> \brief \b DERRLQTP
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 DERRLQTP( 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 *> DERRLQTP tests the error exits for the REAL routines
25 *> that use the LQT decomposition of a triangular-pentagonal matrix.
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 *> \date December 2016
52 *
53 *> \ingroup double_lin
54 *
55 * =====================================================================
56  SUBROUTINE derrlqtp( PATH, NUNIT )
57  IMPLICIT NONE
58 *
59 * -- LAPACK test routine (version 3.7.0) --
60 * -- LAPACK is a software package provided by Univ. of Tennessee, --
61 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
62 * December 2016
63 *
64 * .. Scalar Arguments ..
65  CHARACTER*3 PATH
66  INTEGER NUNIT
67 * ..
68 *
69 * =====================================================================
70 *
71 * .. Parameters ..
72  INTEGER NMAX
73  parameter( nmax = 2 )
74 * ..
75 * .. Local Scalars ..
76  INTEGER I, INFO, J
77 * ..
78 * .. Local Arrays ..
79  DOUBLE PRECISION A( nmax, nmax ), T( nmax, nmax ), W( nmax ),
80  $ b( nmax, nmax ), c( nmax, nmax )
81 * ..
82 * .. External Subroutines ..
83  EXTERNAL alaesm, chkxer, dtplqt2, dtplqt,
84  $ dtpmlqt
85 * ..
86 * .. Scalars in Common ..
87  LOGICAL LERR, OK
88  CHARACTER*32 SRNAMT
89  INTEGER INFOT, NOUT
90 * ..
91 * .. Common blocks ..
92  COMMON / infoc / infot, nout, ok, lerr
93  COMMON / srnamc / srnamt
94 * ..
95 * .. Intrinsic Functions ..
96  INTRINSIC dble
97 * ..
98 * .. Executable Statements ..
99 *
100  nout = nunit
101  WRITE( nout, fmt = * )
102 *
103 * Set the variables to innocuous values.
104 *
105  DO j = 1, nmax
106  DO i = 1, nmax
107  a( i, j ) = 1.d0 / dble( i+j )
108  c( i, j ) = 1.d0 / dble( i+j )
109  t( i, j ) = 1.d0 / dble( i+j )
110  END DO
111  w( j ) = 0.0
112  END DO
113  ok = .true.
114 *
115 * Error exits for TPLQT factorization
116 *
117 * DTPLQT
118 *
119  srnamt = 'DTPLQT'
120  infot = 1
121  CALL dtplqt( -1, 1, 0, 1, a, 1, b, 1, t, 1, w, info )
122  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
123  infot = 2
124  CALL dtplqt( 1, -1, 0, 1, a, 1, b, 1, t, 1, w, info )
125  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
126  infot = 3
127  CALL dtplqt( 0, 1, -1, 1, a, 1, b, 1, t, 1, w, info )
128  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
129  infot = 3
130  CALL dtplqt( 0, 1, 1, 1, a, 1, b, 1, t, 1, w, info )
131  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
132  infot = 4
133  CALL dtplqt( 0, 1, 0, 0, a, 1, b, 1, t, 1, w, info )
134  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
135  infot = 4
136  CALL dtplqt( 1, 1, 0, 2, a, 1, b, 1, t, 1, w, info )
137  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
138  infot = 6
139  CALL dtplqt( 2, 1, 0, 2, a, 1, b, 1, t, 1, w, info )
140  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
141  infot = 8
142  CALL dtplqt( 2, 1, 0, 1, a, 2, b, 1, t, 1, w, info )
143  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
144  infot = 10
145  CALL dtplqt( 2, 2, 1, 2, a, 2, b, 2, t, 1, w, info )
146  CALL chkxer( 'DTPLQT', infot, nout, lerr, ok )
147 *
148 * DTPLQT2
149 *
150  srnamt = 'DTPLQT2'
151  infot = 1
152  CALL dtplqt2( -1, 0, 0, a, 1, b, 1, t, 1, info )
153  CALL chkxer( 'DTPLQT2', infot, nout, lerr, ok )
154  infot = 2
155  CALL dtplqt2( 0, -1, 0, a, 1, b, 1, t, 1, info )
156  CALL chkxer( 'DTPLQT2', infot, nout, lerr, ok )
157  infot = 3
158  CALL dtplqt2( 0, 0, -1, a, 1, b, 1, t, 1, info )
159  CALL chkxer( 'DTPLQT2', infot, nout, lerr, ok )
160  infot = 5
161  CALL dtplqt2( 2, 2, 0, a, 1, b, 2, t, 2, info )
162  CALL chkxer( 'DTPLQT2', infot, nout, lerr, ok )
163  infot = 7
164  CALL dtplqt2( 2, 2, 0, a, 2, b, 1, t, 2, info )
165  CALL chkxer( 'DTPLQT2', infot, nout, lerr, ok )
166  infot = 9
167  CALL dtplqt2( 2, 2, 0, a, 2, b, 2, t, 1, info )
168  CALL chkxer( 'DTPLQT2', infot, nout, lerr, ok )
169 *
170 * DTPMLQT
171 *
172  srnamt = 'DTPMLQT'
173  infot = 1
174  CALL dtpmlqt( '/', 'N', 0, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
175  $ w, info )
176  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
177  infot = 2
178  CALL dtpmlqt( 'L', '/', 0, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
179  $ w, info )
180  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
181  infot = 3
182  CALL dtpmlqt( 'L', 'N', -1, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
183  $ w, info )
184  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
185  infot = 4
186  CALL dtpmlqt( 'L', 'N', 0, -1, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
187  $ w, info )
188  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
189  infot = 5
190  CALL dtpmlqt( 'L', 'N', 0, 0, -1, 0, 1, a, 1, t, 1, b, 1, c, 1,
191  $ w, info )
192  infot = 6
193  CALL dtpmlqt( 'L', 'N', 0, 0, 0, -1, 1, a, 1, t, 1, b, 1, c, 1,
194  $ w, info )
195  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
196  infot = 7
197  CALL dtpmlqt( 'L', 'N', 0, 0, 0, 0, 0, a, 1, t, 1, b, 1, c, 1,
198  $ w, info )
199  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
200  infot = 9
201  CALL dtpmlqt( 'R', 'N', 2, 2, 2, 1, 1, a, 1, t, 1, b, 1, c, 1,
202  $ w, info )
203  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
204  infot = 11
205  CALL dtpmlqt( 'R', 'N', 1, 1, 1, 1, 1, a, 1, t, 0, b, 1, c, 1,
206  $ w, info )
207  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
208  infot = 13
209  CALL dtpmlqt( 'L', 'N', 1, 1, 1, 1, 1, a, 1, t, 1, b, 0, c, 1,
210  $ w, info )
211  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
212  infot = 15
213  CALL dtpmlqt( 'L', 'N', 1, 1, 1, 1, 1, a, 1, t, 1, b, 1, c, 0,
214  $ w, info )
215  CALL chkxer( 'DTPMLQT', infot, nout, lerr, ok )
216 *
217 * Print a summary line.
218 *
219  CALL alaesm( path, ok, nout )
220 *
221  RETURN
222 *
223 * End of DERRLQT
224 *
225  END
subroutine dtpmlqt(SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
DTPMLQT
Definition: dtpmlqt.f:218
subroutine dtplqt(M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, INFO)
DTPLQT
Definition: dtplqt.f:191
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine derrlqtp(PATH, NUNIT)
DERRLQTP
Definition: derrlqtp.f:57
subroutine dtplqt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
DTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
Definition: dtplqt2.f:179
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199