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
227