1*> \brief \b CERRRQ 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 CERRRQ( 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*> CERRRQ tests the error exits for the COMPLEX routines 25*> that use the RQ 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 Denver 49*> \author NAG Ltd. 50* 51*> \date December 2016 52* 53*> \ingroup complex_lin 54* 55* ===================================================================== 56 SUBROUTINE CERRRQ( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.7.0) -- 59* -- LAPACK is a software package provided by Univ. of Tennessee, -- 60* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 61* December 2016 62* 63* .. Scalar Arguments .. 64 CHARACTER*3 PATH 65 INTEGER NUNIT 66* .. 67* 68* ===================================================================== 69* 70* .. Parameters .. 71 INTEGER NMAX 72 PARAMETER ( NMAX = 2 ) 73* .. 74* .. Local Scalars .. 75 INTEGER I, INFO, J 76* .. 77* .. Local Arrays .. 78 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ), 79 $ W( NMAX ), X( NMAX ) 80* .. 81* .. External Subroutines .. 82 EXTERNAL ALAESM, CGERQ2, CGERQF, CGERQS, CHKXER, CUNGR2, 83 $ CUNGRQ, CUNMR2, CUNMRQ 84* .. 85* .. Scalars in Common .. 86 LOGICAL LERR, OK 87 CHARACTER*32 SRNAMT 88 INTEGER INFOT, NOUT 89* .. 90* .. Common blocks .. 91 COMMON / INFOC / INFOT, NOUT, OK, LERR 92 COMMON / SRNAMC / SRNAMT 93* .. 94* .. Intrinsic Functions .. 95 INTRINSIC CMPLX, REAL 96* .. 97* .. Executable Statements .. 98* 99 NOUT = NUNIT 100 WRITE( NOUT, FMT = * ) 101* 102* Set the variables to innocuous values. 103* 104 DO 20 J = 1, NMAX 105 DO 10 I = 1, NMAX 106 A( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 107 AF( I, J ) = CMPLX( 1. / REAL( I+J ), -1. / REAL( I+J ) ) 108 10 CONTINUE 109 B( J ) = 0. 110 W( J ) = 0. 111 X( J ) = 0. 112 20 CONTINUE 113 OK = .TRUE. 114* 115* Error exits for RQ factorization 116* 117* CGERQF 118* 119 SRNAMT = 'CGERQF' 120 INFOT = 1 121 CALL CGERQF( -1, 0, A, 1, B, W, 1, INFO ) 122 CALL CHKXER( 'CGERQF', INFOT, NOUT, LERR, OK ) 123 INFOT = 2 124 CALL CGERQF( 0, -1, A, 1, B, W, 1, INFO ) 125 CALL CHKXER( 'CGERQF', INFOT, NOUT, LERR, OK ) 126 INFOT = 4 127 CALL CGERQF( 2, 1, A, 1, B, W, 2, INFO ) 128 CALL CHKXER( 'CGERQF', INFOT, NOUT, LERR, OK ) 129 INFOT = 7 130 CALL CGERQF( 2, 1, A, 2, B, W, 1, INFO ) 131 CALL CHKXER( 'CGERQF', INFOT, NOUT, LERR, OK ) 132* 133* CGERQ2 134* 135 SRNAMT = 'CGERQ2' 136 INFOT = 1 137 CALL CGERQ2( -1, 0, A, 1, B, W, INFO ) 138 CALL CHKXER( 'CGERQ2', INFOT, NOUT, LERR, OK ) 139 INFOT = 2 140 CALL CGERQ2( 0, -1, A, 1, B, W, INFO ) 141 CALL CHKXER( 'CGERQ2', INFOT, NOUT, LERR, OK ) 142 INFOT = 4 143 CALL CGERQ2( 2, 1, A, 1, B, W, INFO ) 144 CALL CHKXER( 'CGERQ2', INFOT, NOUT, LERR, OK ) 145* 146* CGERQS 147* 148 SRNAMT = 'CGERQS' 149 INFOT = 1 150 CALL CGERQS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO ) 151 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL CGERQS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO ) 154 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 155 INFOT = 2 156 CALL CGERQS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO ) 157 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 158 INFOT = 3 159 CALL CGERQS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO ) 160 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 161 INFOT = 5 162 CALL CGERQS( 2, 2, 0, A, 1, X, B, 2, W, 1, INFO ) 163 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 164 INFOT = 8 165 CALL CGERQS( 2, 2, 0, A, 2, X, B, 1, W, 1, INFO ) 166 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 167 INFOT = 10 168 CALL CGERQS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO ) 169 CALL CHKXER( 'CGERQS', INFOT, NOUT, LERR, OK ) 170* 171* CUNGRQ 172* 173 SRNAMT = 'CUNGRQ' 174 INFOT = 1 175 CALL CUNGRQ( -1, 0, 0, A, 1, X, W, 1, INFO ) 176 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 177 INFOT = 2 178 CALL CUNGRQ( 0, -1, 0, A, 1, X, W, 1, INFO ) 179 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 180 INFOT = 2 181 CALL CUNGRQ( 2, 1, 0, A, 2, X, W, 2, INFO ) 182 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 183 INFOT = 3 184 CALL CUNGRQ( 0, 0, -1, A, 1, X, W, 1, INFO ) 185 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 186 INFOT = 3 187 CALL CUNGRQ( 1, 2, 2, A, 1, X, W, 1, INFO ) 188 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 189 INFOT = 5 190 CALL CUNGRQ( 2, 2, 0, A, 1, X, W, 2, INFO ) 191 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 192 INFOT = 8 193 CALL CUNGRQ( 2, 2, 0, A, 2, X, W, 1, INFO ) 194 CALL CHKXER( 'CUNGRQ', INFOT, NOUT, LERR, OK ) 195* 196* CUNGR2 197* 198 SRNAMT = 'CUNGR2' 199 INFOT = 1 200 CALL CUNGR2( -1, 0, 0, A, 1, X, W, INFO ) 201 CALL CHKXER( 'CUNGR2', INFOT, NOUT, LERR, OK ) 202 INFOT = 2 203 CALL CUNGR2( 0, -1, 0, A, 1, X, W, INFO ) 204 CALL CHKXER( 'CUNGR2', INFOT, NOUT, LERR, OK ) 205 INFOT = 2 206 CALL CUNGR2( 2, 1, 0, A, 2, X, W, INFO ) 207 CALL CHKXER( 'CUNGR2', INFOT, NOUT, LERR, OK ) 208 INFOT = 3 209 CALL CUNGR2( 0, 0, -1, A, 1, X, W, INFO ) 210 CALL CHKXER( 'CUNGR2', INFOT, NOUT, LERR, OK ) 211 INFOT = 3 212 CALL CUNGR2( 1, 2, 2, A, 2, X, W, INFO ) 213 CALL CHKXER( 'CUNGR2', INFOT, NOUT, LERR, OK ) 214 INFOT = 5 215 CALL CUNGR2( 2, 2, 0, A, 1, X, W, INFO ) 216 CALL CHKXER( 'CUNGR2', INFOT, NOUT, LERR, OK ) 217* 218* CUNMRQ 219* 220 SRNAMT = 'CUNMRQ' 221 INFOT = 1 222 CALL CUNMRQ( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 223 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 224 INFOT = 2 225 CALL CUNMRQ( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 226 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 227 INFOT = 3 228 CALL CUNMRQ( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO ) 229 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 230 INFOT = 4 231 CALL CUNMRQ( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO ) 232 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 233 INFOT = 5 234 CALL CUNMRQ( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO ) 235 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 236 INFOT = 5 237 CALL CUNMRQ( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO ) 238 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 239 INFOT = 5 240 CALL CUNMRQ( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO ) 241 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 242 INFOT = 7 243 CALL CUNMRQ( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, 1, INFO ) 244 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 245 INFOT = 7 246 CALL CUNMRQ( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, 1, INFO ) 247 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 248 INFOT = 10 249 CALL CUNMRQ( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, 1, INFO ) 250 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 251 INFOT = 12 252 CALL CUNMRQ( 'L', 'N', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO ) 253 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 254 INFOT = 12 255 CALL CUNMRQ( 'R', 'N', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO ) 256 CALL CHKXER( 'CUNMRQ', INFOT, NOUT, LERR, OK ) 257* 258* CUNMR2 259* 260 SRNAMT = 'CUNMR2' 261 INFOT = 1 262 CALL CUNMR2( '/', 'N', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 263 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 264 INFOT = 2 265 CALL CUNMR2( 'L', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO ) 266 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 267 INFOT = 3 268 CALL CUNMR2( 'L', 'N', -1, 0, 0, A, 1, X, AF, 1, W, INFO ) 269 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 270 INFOT = 4 271 CALL CUNMR2( 'L', 'N', 0, -1, 0, A, 1, X, AF, 1, W, INFO ) 272 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 273 INFOT = 5 274 CALL CUNMR2( 'L', 'N', 0, 0, -1, A, 1, X, AF, 1, W, INFO ) 275 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 276 INFOT = 5 277 CALL CUNMR2( 'L', 'N', 0, 1, 1, A, 1, X, AF, 1, W, INFO ) 278 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 279 INFOT = 5 280 CALL CUNMR2( 'R', 'N', 1, 0, 1, A, 1, X, AF, 1, W, INFO ) 281 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 282 INFOT = 7 283 CALL CUNMR2( 'L', 'N', 2, 1, 2, A, 1, X, AF, 2, W, INFO ) 284 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 285 INFOT = 7 286 CALL CUNMR2( 'R', 'N', 1, 2, 2, A, 1, X, AF, 1, W, INFO ) 287 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 288 INFOT = 10 289 CALL CUNMR2( 'L', 'N', 2, 1, 0, A, 1, X, AF, 1, W, INFO ) 290 CALL CHKXER( 'CUNMR2', INFOT, NOUT, LERR, OK ) 291* 292* Print a summary line. 293* 294 CALL ALAESM( PATH, OK, NOUT ) 295* 296 RETURN 297* 298* End of CERRRQ 299* 300 END 301