LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ cerrqrt()

subroutine cerrqrt ( character*3  PATH,
integer  NUNIT 
)

CERRQRT

Purpose:
 CERRQRT tests the error exits for the COMPLEX routines
 that use the QRT 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 cerrqrt.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
74 * ..
75 * .. Local Arrays ..
76  COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77  $ C( NMAX, NMAX )
78 * ..
79 * .. External Subroutines ..
80  EXTERNAL alaesm, chkxer, cgeqrt2, cgeqrt3, cgeqrt,
81  $ cgemqrt
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 float, cmplx
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.0 / cmplx( float(i+j), 0.0 )
105  c( i, j ) = 1.0 / cmplx( float(i+j), 0.0 )
106  t( i, j ) = 1.0 / cmplx( float(i+j), 0.0 )
107  END DO
108  w( j ) = 0.0
109  END DO
110  ok = .true.
111 *
112 * Error exits for QRT factorization
113 *
114 * CGEQRT
115 *
116  srnamt = 'CGEQRT'
117  infot = 1
118  CALL cgeqrt( -1, 0, 1, a, 1, t, 1, w, info )
119  CALL chkxer( 'CGEQRT', infot, nout, lerr, ok )
120  infot = 2
121  CALL cgeqrt( 0, -1, 1, a, 1, t, 1, w, info )
122  CALL chkxer( 'CGEQRT', infot, nout, lerr, ok )
123  infot = 3
124  CALL cgeqrt( 0, 0, 0, a, 1, t, 1, w, info )
125  CALL chkxer( 'CGEQRT', infot, nout, lerr, ok )
126  infot = 5
127  CALL cgeqrt( 2, 1, 1, a, 1, t, 1, w, info )
128  CALL chkxer( 'CGEQRT', infot, nout, lerr, ok )
129  infot = 7
130  CALL cgeqrt( 2, 2, 2, a, 2, t, 1, w, info )
131  CALL chkxer( 'CGEQRT', infot, nout, lerr, ok )
132 *
133 * CGEQRT2
134 *
135  srnamt = 'CGEQRT2'
136  infot = 1
137  CALL cgeqrt2( -1, 0, a, 1, t, 1, info )
138  CALL chkxer( 'CGEQRT2', infot, nout, lerr, ok )
139  infot = 2
140  CALL cgeqrt2( 0, -1, a, 1, t, 1, info )
141  CALL chkxer( 'CGEQRT2', infot, nout, lerr, ok )
142  infot = 4
143  CALL cgeqrt2( 2, 1, a, 1, t, 1, info )
144  CALL chkxer( 'CGEQRT2', infot, nout, lerr, ok )
145  infot = 6
146  CALL cgeqrt2( 2, 2, a, 2, t, 1, info )
147  CALL chkxer( 'CGEQRT2', infot, nout, lerr, ok )
148 *
149 * CGEQRT3
150 *
151  srnamt = 'CGEQRT3'
152  infot = 1
153  CALL cgeqrt3( -1, 0, a, 1, t, 1, info )
154  CALL chkxer( 'CGEQRT3', infot, nout, lerr, ok )
155  infot = 2
156  CALL cgeqrt3( 0, -1, a, 1, t, 1, info )
157  CALL chkxer( 'CGEQRT3', infot, nout, lerr, ok )
158  infot = 4
159  CALL cgeqrt3( 2, 1, a, 1, t, 1, info )
160  CALL chkxer( 'CGEQRT3', infot, nout, lerr, ok )
161  infot = 6
162  CALL cgeqrt3( 2, 2, a, 2, t, 1, info )
163  CALL chkxer( 'CGEQRT3', infot, nout, lerr, ok )
164 *
165 * CGEMQRT
166 *
167  srnamt = 'CGEMQRT'
168  infot = 1
169  CALL cgemqrt( '/', 'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
170  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
171  infot = 2
172  CALL cgemqrt( 'L', '/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
173  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
174  infot = 3
175  CALL cgemqrt( 'L', 'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
176  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
177  infot = 4
178  CALL cgemqrt( 'L', 'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
179  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
180  infot = 5
181  CALL cgemqrt( 'L', 'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
182  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
183  infot = 5
184  CALL cgemqrt( 'R', 'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
185  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
186  infot = 6
187  CALL cgemqrt( 'L', 'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
188  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
189  infot = 8
190  CALL cgemqrt( 'R', 'N', 1, 2, 1, 1, a, 1, t, 1, c, 1, w, info )
191  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
192  infot = 8
193  CALL cgemqrt( 'L', 'N', 2, 1, 1, 1, a, 1, t, 1, c, 1, w, info )
194  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
195  infot = 10
196  CALL cgemqrt( 'R', 'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
197  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
198  infot = 12
199  CALL cgemqrt( 'L', 'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
200  CALL chkxer( 'CGEMQRT', infot, nout, lerr, ok )
201 *
202 * Print a summary line.
203 *
204  CALL alaesm( path, ok, nout )
205 *
206  RETURN
207 *
208 * End of CERRQRT
209 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
CGEMQRT
Definition: cgemqrt.f:168
recursive subroutine cgeqrt3(M, N, A, LDA, T, LDT, INFO)
CGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact...
Definition: cgeqrt3.f:132
subroutine cgeqrt2(M, N, A, LDA, T, LDT, INFO)
CGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY represen...
Definition: cgeqrt2.f:127
subroutine cgeqrt(M, N, NB, A, LDA, T, LDT, WORK, INFO)
CGEQRT
Definition: cgeqrt.f:141
Here is the call graph for this function:
Here is the caller graph for this function: