LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cerrtsqr()

subroutine cerrtsqr ( character*3  PATH,
integer  NUNIT 
)

CERRTSQR

Purpose:
 CERRTSQR tests the error exits for the COMPLEX 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 cerrtsqr.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, NB
74 * ..
75 * .. Local Arrays ..
76  COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77  $ C( NMAX, NMAX ), TAU(NMAX)
78 * ..
79 * .. External Subroutines ..
80  EXTERNAL alaesm, chkxer, cgeqr,
81  $ cgemqr, cgelq, cgemlq
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.e0 / cmplx( real( i+j ), 0.e0 )
105  c( i, j ) = 1.e0 / cmplx( real( i+j ), 0.e0 )
106  t( i, j ) = 1.e0 / cmplx( real( i+j ), 0.e0 )
107  END DO
108  w( j ) = 0.e0
109  END DO
110  ok = .true.
111 *
112 * Error exits for TS factorization
113 *
114 * CGEQR
115 *
116  srnamt = 'CGEQR'
117  infot = 1
118  CALL cgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
119  CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
120  infot = 2
121  CALL cgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
122  CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
123  infot = 4
124  CALL cgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
125  CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
126  infot = 6
127  CALL cgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
128  CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
129  infot = 8
130  CALL cgeqr( 3, 2, a, 3, tau, 8, w, 0, info )
131  CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
132 *
133 * CGEMQR
134 *
135  tau(1)=1
136  tau(2)=1
137  srnamt = 'CGEMQR'
138  nb=1
139  infot = 1
140  CALL cgemqr( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
141  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
142  infot = 2
143  CALL cgemqr( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
144  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
145  infot = 3
146  CALL cgemqr( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
147  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
148  infot = 4
149  CALL cgemqr( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
150  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
151  infot = 5
152  CALL cgemqr( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
153  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
154  infot = 5
155  CALL cgemqr( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
156  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
157  infot = 7
158  CALL cgemqr( 'L', 'N', 2, 1, 0, a, 0, tau, 1, c, 1, w, 1,info)
159  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
160  infot = 9
161  CALL cgemqr( 'R', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
162  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
163  infot = 9
164  CALL cgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 0, c, 1, w, 1,info)
165  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
166  infot = 11
167  CALL cgemqr( 'L', 'N', 2, 1, 1, a, 2, tau, 6, c, 0, w, 1,info)
168  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
169  infot = 13
170  CALL cgemqr( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
171  CALL chkxer( 'CGEMQR', infot, nout, lerr, ok )
172 *
173 * CGELQ
174 *
175  srnamt = 'CGELQ'
176  infot = 1
177  CALL cgelq( -1, 0, a, 1, tau, 1, w, 1, info )
178  CALL chkxer( 'CGELQ', infot, nout, lerr, ok )
179  infot = 2
180  CALL cgelq( 0, -1, a, 1, tau, 1, w, 1, info )
181  CALL chkxer( 'CGELQ', infot, nout, lerr, ok )
182  infot = 4
183  CALL cgelq( 1, 1, a, 0, tau, 1, w, 1, info )
184  CALL chkxer( 'CGELQ', infot, nout, lerr, ok )
185  infot = 6
186  CALL cgelq( 2, 3, a, 3, tau, 1, w, 1, info )
187  CALL chkxer( 'CGELQ', infot, nout, lerr, ok )
188  infot = 8
189  CALL cgelq( 2, 3, a, 3, tau, 8, w, 0, info )
190  CALL chkxer( 'CGELQ', infot, nout, lerr, ok )
191 *
192 * CGEMLQ
193 *
194  tau(1)=1
195  tau(2)=1
196  srnamt = 'CGEMLQ'
197  nb=1
198  infot = 1
199  CALL cgemlq( '/', 'N', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
200  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
201  infot = 2
202  CALL cgemlq( 'L', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
203  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
204  infot = 3
205  CALL cgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
206  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
207  infot = 4
208  CALL cgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
209  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
210  infot = 5
211  CALL cgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
212  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
213  infot = 5
214  CALL cgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
215  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
216  infot = 7
217  CALL cgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
218  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
219  infot = 9
220  CALL cgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
221  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
222  infot = 9
223  CALL cgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
224  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
225  infot = 11
226  CALL cgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
227  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
228  infot = 13
229  CALL cgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
230  CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
231 *
232 * Print a summary line.
233 *
234  CALL alaesm( path, ok, nout )
235 *
236  RETURN
237 *
238 * End of CERRTSQR
239 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
cgelq
subroutine cgelq(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
CGELQ
Definition: cgelq.f:172
cgemlq
subroutine cgemlq(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
CGEMLQ
Definition: cgemlq.f:170
cgemqr
subroutine cgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
CGEMQR
Definition: cgemqr.f:172
cgeqr
subroutine cgeqr(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
CGEQR
Definition: cgeqr.f:174
alaesm
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: