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 )
121 CALL ztplqt( -1, 1, 0, 1, a, 1, b, 1, t, 1, w, info )
122 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
124 CALL ztplqt( 1, -1, 0, 1, a, 1, b, 1, t, 1, w, info )
125 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
127 CALL ztplqt( 0, 1, -1, 1, a, 1, b, 1, t, 1, w, info )
128 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
130 CALL ztplqt( 0, 1, 1, 1, a, 1, b, 1, t, 1, w, info )
131 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
133 CALL ztplqt( 0, 1, 0, 0, a, 1, b, 1, t, 1, w, info )
134 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
136 CALL ztplqt( 1, 1, 0, 2, a, 1, b, 1, t, 1, w, info )
137 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
139 CALL ztplqt( 2, 1, 0, 2, a, 1, b, 1, t, 1, w, info )
140 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
142 CALL ztplqt( 2, 1, 0, 1, a, 2, b, 1, t, 1, w, info )
143 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
145 CALL ztplqt( 2, 2, 1, 2, a, 2, b, 2, t, 1, w, info )
146 CALL chkxer(
'ZTPLQT', infot, nout, lerr, ok )
152 CALL ztplqt2( -1, 0, 0, a, 1, b, 1, t, 1, info )
153 CALL chkxer(
'ZTPLQT2', infot, nout, lerr, ok )
155 CALL ztplqt2( 0, -1, 0, a, 1, b, 1, t, 1, info )
156 CALL chkxer(
'ZTPLQT2', infot, nout, lerr, ok )
158 CALL ztplqt2( 0, 0, -1, a, 1, b, 1, t, 1, info )
159 CALL chkxer(
'ZTPLQT2', infot, nout, lerr, ok )
161 CALL ztplqt2( 2, 2, 0, a, 1, b, 2, t, 2, info )
162 CALL chkxer(
'ZTPLQT2', infot, nout, lerr, ok )
164 CALL ztplqt2( 2, 2, 0, a, 2, b, 1, t, 2, info )
165 CALL chkxer(
'ZTPLQT2', infot, nout, lerr, ok )
167 CALL ztplqt2( 2, 2, 0, a, 2, b, 2, t, 1, info )
168 CALL chkxer(
'ZTPLQT2', infot, nout, lerr, ok )
174 CALL ztpmlqt(
'/',
'N', 0, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
176 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
178 CALL ztpmlqt(
'L',
'/', 0, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
180 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
182 CALL ztpmlqt(
'L',
'N', -1, 0, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
184 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
186 CALL ztpmlqt(
'L',
'N', 0, -1, 0, 0, 1, a, 1, t, 1, b, 1, c, 1,
188 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
190 CALL ztpmlqt(
'L',
'N', 0, 0, -1, 0, 1, a, 1, t, 1, b, 1, c, 1,
193 CALL ztpmlqt(
'L',
'N', 0, 0, 0, -1, 1, a, 1, t, 1, b, 1, c, 1,
195 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
197 CALL ztpmlqt(
'L',
'N', 0, 0, 0, 0, 0, a, 1, t, 1, b, 1, c, 1,
199 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
201 CALL ztpmlqt(
'R',
'N', 2, 2, 2, 1, 1, a, 1, t, 1, b, 1, c, 1,
203 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
205 CALL ztpmlqt(
'R',
'N', 1, 1, 1, 1, 1, a, 1, t, 0, b, 1, c, 1,
207 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
209 CALL ztpmlqt(
'L',
'N', 1, 1, 1, 1, 1, a, 1, t, 1, b, 0, c, 1,
211 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
213 CALL ztpmlqt(
'L',
'N', 1, 1, 1, 1, 1, a, 1, t, 1, b, 1, c, 0,
215 CALL chkxer(
'ZTPMLQT', infot, nout, lerr, ok )
219 CALL alaesm( path, ok, nout )
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine ztplqt(M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, INFO)
ZTPLQT
subroutine ztpmlqt(SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, A, LDA, B, LDB, WORK, INFO)
ZTPMLQT
subroutine ztplqt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
ZTPLQT2 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.
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)