LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ derrtsqr()

subroutine derrtsqr ( character*3  PATH,
integer  NUNIT 
)

DERRTSQR

Purpose:
 DERRTSQR tests the error exits for the DOUBLE 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 Denver
NAG Ltd.

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