LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ serrtsqr()

subroutine serrtsqr ( character*3  PATH,
integer  NUNIT 
)

DERRTSQR

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