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