73 parameter ( nmax = 2 )
79 COMPLEX*16 a( nmax, nmax ), t( nmax, nmax ), w( nmax ),
80 $ b( nmax, nmax ), c( nmax, nmax )
92 COMMON / infoc / infot, nout, ok, lerr
93 COMMON / srnamc / srnamt
96 INTRINSIC dble, dcmplx
101 WRITE( nout, fmt = * )
107 a( i, j ) = 1.d0 / dcmplx(dble( i+j ),0.d0)
108 c( i, j ) = 1.d0 / dcmplx(dble( i+j ),0.d0)
109 t( i, j ) = 1.d0 / dcmplx(dble( i+j ),0.d0)
111 w( j ) = dcmplx(0.d0,0.d0)
121 CALL ztpqrt( -1, 1, 0, 1, a, 1, b, 1, t, 1, w, info )
122 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
124 CALL ztpqrt( 1, -1, 0, 1, a, 1, b, 1, t, 1, w, info )
125 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
127 CALL ztpqrt( 0, 1, -1, 1, a, 1, b, 1, t, 1, w, info )
128 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
130 CALL ztpqrt( 0, 1, 1, 1, a, 1, b, 1, t, 1, w, info )
131 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
133 CALL ztpqrt( 0, 1, 0, 0, a, 1, b, 1, t, 1, w, info )
134 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
136 CALL ztpqrt( 0, 1, 0, 2, a, 1, b, 1, t, 1, w, info )
137 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
139 CALL ztpqrt( 1, 2, 0, 2, a, 1, b, 1, t, 1, w, info )
140 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
142 CALL ztpqrt( 2, 1, 0, 1, a, 1, b, 1, t, 1, w, info )
143 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
145 CALL ztpqrt( 2, 2, 1, 2, a, 2, b, 2, t, 1, w, info )
146 CALL chkxer(
'ZTPQRT', infot, nout, lerr, ok )
152 CALL ztpqrt2( -1, 0, 0, a, 1, b, 1, t, 1, info )
153 CALL chkxer(
'ZTPQRT2', infot, nout, lerr, ok )
155 CALL ztpqrt2( 0, -1, 0, a, 1, b, 1, t, 1, info )
156 CALL chkxer(
'ZTPQRT2', infot, nout, lerr, ok )
158 CALL ztpqrt2( 0, 0, -1, a, 1, b, 1, t, 1, info )
159 CALL chkxer(
'ZTPQRT2', infot, nout, lerr, ok )
161 CALL ztpqrt2( 2, 2, 0, a, 1, b, 2, t, 2, info )
162 CALL chkxer(
'ZTPQRT2', infot, nout, lerr, ok )
164 CALL ztpqrt2( 2, 2, 0, a, 2, b, 1, t, 2, info )
165 CALL chkxer(
'ZTPQRT2', infot, nout, lerr, ok )
167 CALL ztpqrt2( 2, 2, 0, a, 2, b, 2, t, 1, info )
168 CALL chkxer(
'ZTPQRT2', infot, nout, lerr, ok )
174 CALL ztpmqrt(
'/',
'N', 0, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
176 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
178 CALL ztpmqrt(
'L',
'/', 0, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
180 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
182 CALL ztpmqrt(
'L',
'N', -1, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
184 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
186 CALL ztpmqrt(
'L',
'N', 0, -1, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
188 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
190 CALL ztpmqrt(
'L',
'N', 0, 0, -1, 0, 1, a, 1, t, 1, b, 1, c, 1,
193 CALL ztpmqrt(
'L',
'N', 0, 0, 0, -1, 1, a, 1, t, 1, b, 1, c, 1,
195 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
197 CALL ztpmqrt(
'L',
'N', 0, 0, 0, 0, 0, a, 1, t, 1, b, 1, c, 1,
199 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
201 CALL ztpmqrt(
'R',
'N', 1, 2, 1, 1, 1, a, 1, t, 1, b, 1, c, 1,
203 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
205 CALL ztpmqrt(
'L',
'N', 2, 1, 1, 1, 1, a, 1, t, 1, b, 1, c, 1,
207 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
209 CALL ztpmqrt(
'R',
'N', 1, 1, 1, 1, 1, a, 1, t, 0, b, 1, c, 1,
211 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
213 CALL ztpmqrt(
'L',
'N', 1, 1, 1, 1, 1, a, 1, t, 1, b, 0, c, 1,
215 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
217 CALL ztpmqrt(
'L',
'N', 1, 1, 1, 1, 1, a, 1, t, 1, b, 1, c, 0,
219 CALL chkxer(
'ZTPMQRT', infot, nout, lerr, ok )
223 CALL alaesm( path, ok, nout )
subroutine alaesm(PATH, OK, NOUT)
ALAESM
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, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine ztpmqrt(SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
ZTPMQRT
subroutine ztpqrt(M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK, INFO)
ZTPQRT