1*> \brief \b CERRTSQR 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CERRTSQR( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> CERRTSQR tests the error exits for the COMPLEX routines 25*> that use the TSQR decomposition of a general matrix. 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Zenver 49*> \author NAG Ltd. 50* 51*> \date December 2016 52* 53*> \ingroup double_lin 54* 55* ===================================================================== 56 SUBROUTINE CERRTSQR( PATH, NUNIT ) 57 IMPLICIT NONE 58* 59* -- LAPACK test routine (version 3.7.0) -- 60* -- LAPACK is a software package provided by Univ. of Tennessee, -- 61* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 62* December 2016 63* 64* .. Scalar Arguments .. 65 CHARACTER*3 PATH 66 INTEGER NUNIT 67* .. 68* 69* ===================================================================== 70* 71* .. Parameters .. 72 INTEGER NMAX 73 PARAMETER ( NMAX = 2 ) 74* .. 75* .. Local Scalars .. 76 INTEGER I, INFO, J, NB 77* .. 78* .. Local Arrays .. 79 COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 80 $ C( NMAX, NMAX ), TAU(NMAX) 81* .. 82* .. External Subroutines .. 83 EXTERNAL ALAESM, CHKXER, CGEQR, 84 $ CGEMQR, CGELQ, CGEMLQ 85* .. 86* .. Scalars in Common .. 87 LOGICAL LERR, OK 88 CHARACTER*32 SRNAMT 89 INTEGER INFOT, NOUT 90* .. 91* .. Common blocks .. 92 COMMON / INFOC / INFOT, NOUT, OK, LERR 93 COMMON / SRNAMC / SRNAMT 94* .. 95* .. Intrinsic Functions .. 96 INTRINSIC REAL 97* .. 98* .. Executable Statements .. 99* 100 NOUT = NUNIT 101 WRITE( NOUT, FMT = * ) 102* 103* Set the variables to innocuous values. 104* 105 DO J = 1, NMAX 106 DO I = 1, NMAX 107 A( I, J ) = 1.E0 / CMPLX( REAL( I+J ), 0.E0 ) 108 C( I, J ) = 1.E0 / CMPLX( REAL( I+J ), 0.E0 ) 109 T( I, J ) = 1.E0 / CMPLX( REAL( I+J ), 0.E0 ) 110 END DO 111 W( J ) = 0.E0 112 END DO 113 OK = .TRUE. 114* 115* Error exits for TS factorization 116* 117* CGEQR 118* 119 SRNAMT = 'CGEQR' 120 INFOT = 1 121 CALL CGEQR( -1, 0, A, 1, TAU, 1, W, 1, INFO ) 122 CALL CHKXER( 'CGEQR', INFOT, NOUT, LERR, OK ) 123 INFOT = 2 124 CALL CGEQR( 0, -1, A, 1, TAU, 1, W, 1, INFO ) 125 CALL CHKXER( 'CGEQR', INFOT, NOUT, LERR, OK ) 126 INFOT = 4 127 CALL CGEQR( 1, 1, A, 0, TAU, 1, W, 1, INFO ) 128 CALL CHKXER( 'CGEQR', INFOT, NOUT, LERR, OK ) 129 INFOT = 6 130 CALL CGEQR( 3, 2, A, 3, TAU, 1, W, 1, INFO ) 131 CALL CHKXER( 'CGEQR', INFOT, NOUT, LERR, OK ) 132 INFOT = 8 133 CALL CGEQR( 3, 2, A, 3, TAU, 8, W, 0, INFO ) 134 CALL CHKXER( 'CGEQR', INFOT, NOUT, LERR, OK ) 135* 136* CGEMQR 137* 138 TAU(1)=1 139 TAU(2)=1 140 SRNAMT = 'CGEMQR' 141 NB=1 142 INFOT = 1 143 CALL CGEMQR( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 144 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 145 INFOT = 2 146 CALL CGEMQR( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 147 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 148 INFOT = 3 149 CALL CGEMQR( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 150 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 151 INFOT = 4 152 CALL CGEMQR( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 153 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 154 INFOT = 5 155 CALL CGEMQR( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 156 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 157 INFOT = 5 158 CALL CGEMQR( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 159 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 160 INFOT = 7 161 CALL CGEMQR( 'L', 'N', 2, 1, 0, A, 0, TAU, 1, C, 1, W, 1,INFO) 162 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 163 INFOT = 9 164 CALL CGEMQR( 'R', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO) 165 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 166 INFOT = 9 167 CALL CGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO) 168 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 169 INFOT = 11 170 CALL CGEMQR( 'L', 'N', 2, 1, 1, A, 2, TAU, 6, C, 0, W, 1,INFO) 171 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 172 INFOT = 13 173 CALL CGEMQR( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO) 174 CALL CHKXER( 'CGEMQR', INFOT, NOUT, LERR, OK ) 175* 176* CGELQ 177* 178 SRNAMT = 'CGELQ' 179 INFOT = 1 180 CALL CGELQ( -1, 0, A, 1, TAU, 1, W, 1, INFO ) 181 CALL CHKXER( 'CGELQ', INFOT, NOUT, LERR, OK ) 182 INFOT = 2 183 CALL CGELQ( 0, -1, A, 1, TAU, 1, W, 1, INFO ) 184 CALL CHKXER( 'CGELQ', INFOT, NOUT, LERR, OK ) 185 INFOT = 4 186 CALL CGELQ( 1, 1, A, 0, TAU, 1, W, 1, INFO ) 187 CALL CHKXER( 'CGELQ', INFOT, NOUT, LERR, OK ) 188 INFOT = 6 189 CALL CGELQ( 2, 3, A, 3, TAU, 1, W, 1, INFO ) 190 CALL CHKXER( 'CGELQ', INFOT, NOUT, LERR, OK ) 191 INFOT = 8 192 CALL CGELQ( 2, 3, A, 3, TAU, 8, W, 0, INFO ) 193 CALL CHKXER( 'CGELQ', INFOT, NOUT, LERR, OK ) 194* 195* CGEMLQ 196* 197 TAU(1)=1 198 TAU(2)=1 199 SRNAMT = 'CGEMLQ' 200 NB=1 201 INFOT = 1 202 CALL CGEMLQ( '/', 'N', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 203 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 204 INFOT = 2 205 CALL CGEMLQ( 'L', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO) 206 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 207 INFOT = 3 208 CALL CGEMLQ( 'L', 'N', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 209 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 210 INFOT = 4 211 CALL CGEMLQ( 'L', 'N', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO) 212 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 213 INFOT = 5 214 CALL CGEMLQ( 'L', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 215 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 216 INFOT = 5 217 CALL CGEMLQ( 'R', 'N', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO) 218 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 219 INFOT = 7 220 CALL CGEMLQ( 'L', 'N', 1, 2, 0, A, 0, TAU, 1, C, 1, W, 1,INFO) 221 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 222 INFOT = 9 223 CALL CGEMLQ( 'R', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO) 224 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 225 INFOT = 9 226 CALL CGEMLQ( 'L', 'N', 2, 2, 1, A, 1, TAU, 0, C, 1, W, 1,INFO) 227 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 228 INFOT = 11 229 CALL CGEMLQ( 'L', 'N', 1, 2, 1, A, 1, TAU, 6, C, 0, W, 1,INFO) 230 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 231 INFOT = 13 232 CALL CGEMLQ( 'L', 'N', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO) 233 CALL CHKXER( 'CGEMLQ', INFOT, NOUT, LERR, OK ) 234* 235* Print a summary line. 236* 237 CALL ALAESM( PATH, OK, NOUT ) 238* 239 RETURN 240* 241* End of CERRTSQR 242* 243 END 244