LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ zerrtsqr()

subroutine zerrtsqr ( character*3  PATH,
integer  NUNIT 
)

ZERRTSQR

Purpose:
 ZERRTSQR tests the error exits for the ZOUBLE PRECISION routines
 that use the TSQR decomposition of a general matrix.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Zenver
NAG Ltd.

Definition at line 54 of file zerrtsqr.f.

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, MB, NB
74 * ..
75 * .. Local Arrays ..
76  COMPLEX*16 A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77  $ C( NMAX, NMAX ), TAU(NMAX)
78 * ..
79 * .. External Subroutines ..
80  EXTERNAL alaesm, chkxer, zgeqr,
81  $ zgemqr, zgelq, zgemlq
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
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 / dble( i+j )
105  c( i, j ) = 1.d0 / dble( i+j )
106  t( i, j ) = 1.d0 / dble( i+j )
107  END DO
108  w( j ) = 0.d0
109  END DO
110  ok = .true.
111 *
112 * Error exits for TS factorization
113 *
114 * ZGEQR
115 *
116  srnamt = 'ZGEQR'
117  infot = 1
118  CALL zgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
119  CALL chkxer( 'ZGEQR', infot, nout, lerr, ok )
120  infot = 2
121  CALL zgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
122  CALL chkxer( 'ZGEQR', infot, nout, lerr, ok )
123  infot = 4
124  CALL zgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
125  CALL chkxer( 'ZGEQR', infot, nout, lerr, ok )
126  infot = 6
127  CALL zgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
128  CALL chkxer( 'ZGEQR', infot, nout, lerr, ok )
129  infot = 8
130  CALL zgeqr( 3, 2, a, 3, tau, 8, w, 0, info )
131  CALL chkxer( 'ZGEQR', infot, nout, lerr, ok )
132 *
133 * ZLATSQR
134 *
135  mb = 1
136  nb = 1
137  srnamt = 'ZLATSQR'
138  infot = 1
139  CALL zlatsqr( -1, 0, mb, nb, a, 1, tau, 1, w, 1, info )
140  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
141  infot = 2
142  CALL zlatsqr( 1, 2, mb, nb, a, 1, tau, 1, w, 1, info )
143  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
144  CALL zlatsqr( 0, -1, mb, nb, a, 1, tau, 1, w, 1, info )
145  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
146  infot = 3
147  CALL zlatsqr( 2, 1, -1, nb, a, 2, tau, 1, w, 1, info )
148  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
149  infot = 4
150  CALL zlatsqr( 2, 1, mb, 2, a, 2, tau, 1, w, 1, info )
151  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
152  infot = 6
153  CALL zlatsqr( 2, 1, mb, nb, a, 1, tau, 1, w, 1, info )
154  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
155  infot = 8
156  CALL zlatsqr( 2, 1, mb, nb, a, 2, tau, 0, w, 1, info )
157  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
158  infot = 10
159  CALL zlatsqr( 2, 1, mb, nb, a, 2, tau, 2, w, 0, info )
160  CALL chkxer( 'ZLATSQR', infot, nout, lerr, ok )
161 *
162 * ZGEMQR
163 *
164  tau(1)=1
165  tau(2)=1
166  srnamt = 'ZGEMQR'
167  nb=1
168  infot = 1
169  CALL zgemqr( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
170  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
171  infot = 2
172  CALL zgemqr( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
173  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
174  infot = 3
175  CALL zgemqr( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
176  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
177  infot = 4
178  CALL zgemqr( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
179  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
180  infot = 5
181  CALL zgemqr( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
182  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
183  infot = 5
184  CALL zgemqr( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
185  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
186  infot = 7
187  CALL zgemqr( 'L', 'N', 2, 1, 0, a, 0, tau, 1, c, 1, w, 1,info)
188  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
189  infot = 9
190  CALL zgemqr( 'R', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
191  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
192  infot = 9
193  CALL zgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
194  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
195  infot = 11
196  CALL zgemqr( 'L', 'N', 2, 1, 1, a, 2, tau, 6, c, 0, w, 1,info)
197  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
198  infot = 13
199  CALL zgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
200  CALL chkxer( 'ZGEMQR', infot, nout, lerr, ok )
201 *
202 * ZGELQ
203 *
204  srnamt = 'ZGELQ'
205  infot = 1
206  CALL zgelq( -1, 0, a, 1, tau, 1, w, 1, info )
207  CALL chkxer( 'ZGELQ', infot, nout, lerr, ok )
208  infot = 2
209  CALL zgelq( 0, -1, a, 1, tau, 1, w, 1, info )
210  CALL chkxer( 'ZGELQ', infot, nout, lerr, ok )
211  infot = 4
212  CALL zgelq( 1, 1, a, 0, tau, 1, w, 1, info )
213  CALL chkxer( 'ZGELQ', infot, nout, lerr, ok )
214  infot = 6
215  CALL zgelq( 2, 3, a, 3, tau, 1, w, 1, info )
216  CALL chkxer( 'ZGELQ', infot, nout, lerr, ok )
217  infot = 8
218  CALL zgelq( 2, 3, a, 3, tau, 8, w, 0, info )
219  CALL chkxer( 'ZGELQ', infot, nout, lerr, ok )
220 *
221 * ZLASWLQ
222 *
223  mb = 1
224  nb = 1
225  srnamt = 'ZLASWLQ'
226  infot = 1
227  CALL zlaswlq( -1, 0, mb, nb, a, 1, tau, 1, w, 1, info )
228  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
229  infot = 2
230  CALL zlaswlq( 2, 1, mb, nb, a, 1, tau, 1, w, 1, info )
231  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
232  CALL zlaswlq( 0, -1, mb, nb, a, 1, tau, 1, w, 1, info )
233  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
234  infot = 3
235  CALL zlaswlq( 1, 2, -1, nb, a, 1, tau, 1, w, 1, info )
236  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
237  CALL zlaswlq( 1, 1, 2, nb, a, 1, tau, 1, w, 1, info )
238  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
239  infot = 4
240  CALL zlaswlq( 1, 2, mb, -1, a, 1, tau, 1, w, 1, info )
241  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
242  infot = 6
243  CALL zlaswlq( 1, 2, mb, nb, a, 0, tau, 1, w, 1, info )
244  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
245  infot = 8
246  CALL zlaswlq( 1, 2, mb, nb, a, 1, tau, 0, w, 1, info )
247  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
248  infot = 10
249  CALL zlaswlq( 1, 2, mb, nb, a, 1, tau, 1, w, 0, info )
250  CALL chkxer( 'ZLASWLQ', infot, nout, lerr, ok )
251 *
252 * ZGEMLQ
253 *
254  tau(1)=1
255  tau(2)=1
256  srnamt = 'ZGEMLQ'
257  nb=1
258  infot = 1
259  CALL zgemlq( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
260  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
261  infot = 2
262  CALL zgemlq( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
263  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
264  infot = 3
265  CALL zgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
266  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
267  infot = 4
268  CALL zgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
269  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
270  infot = 5
271  CALL zgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
272  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
273  infot = 5
274  CALL zgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
275  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
276  infot = 7
277  CALL zgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
278  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
279  infot = 9
280  CALL zgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
281  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
282  infot = 9
283  CALL zgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
284  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
285  infot = 11
286  CALL zgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
287  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
288  infot = 13
289  CALL zgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
290  CALL chkxer( 'ZGEMLQ', infot, nout, lerr, ok )
291 *
292 * Print a summary line.
293 *
294  CALL alaesm( path, ok, nout )
295 *
296  RETURN
297 *
298 * End of ZERRTSQR
299 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
zgelq
subroutine zgelq(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
ZGELQ
Definition: zgelq.f:172
zgemlq
subroutine zgemlq(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
ZGEMLQ
Definition: zgemlq.f:169
zgemqr
subroutine zgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
ZGEMQR
Definition: zgemqr.f:172
zgeqr
subroutine zgeqr(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
ZGEQR
Definition: zgeqr.f:174
zlaswlq
subroutine zlaswlq(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
ZLASWLQ
Definition: zlaswlq.f:164
zlatsqr
subroutine zlatsqr(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
ZLATSQR
Definition: zlatsqr.f:166
Here is the call graph for this function:
Here is the caller graph for this function: