1*> \brief \b CERRGT 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 CERRGT( 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*> CERRGT tests the error exits for the COMPLEX tridiagonal 25*> routines. 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 November 2011 52* 53*> \ingroup complex_lin 54* 55* ===================================================================== 56 SUBROUTINE CERRGT( PATH, NUNIT ) 57* 58* -- LAPACK test routine (version 3.4.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* November 2011 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 CHARACTER*2 C2 76 INTEGER I, INFO 77 REAL ANORM, RCOND 78* .. 79* .. Local Arrays .. 80 INTEGER IP( NMAX ) 81 REAL D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ), 82 $ RW( NMAX ) 83 COMPLEX B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ), 84 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ), 85 $ EF( NMAX ), W( NMAX ), X( NMAX ) 86* .. 87* .. External Functions .. 88 LOGICAL LSAMEN 89 EXTERNAL LSAMEN 90* .. 91* .. External Subroutines .. 92 EXTERNAL ALAESM, CGTCON, CGTRFS, CGTTRF, CGTTRS, CHKXER, 93 $ CPTCON, CPTRFS, CPTTRF, CPTTRS 94* .. 95* .. Scalars in Common .. 96 LOGICAL LERR, OK 97 CHARACTER*32 SRNAMT 98 INTEGER INFOT, NOUT 99* .. 100* .. Common blocks .. 101 COMMON / INFOC / INFOT, NOUT, OK, LERR 102 COMMON / SRNAMC / SRNAMT 103* .. 104* .. Executable Statements .. 105* 106 NOUT = NUNIT 107 WRITE( NOUT, FMT = * ) 108 C2 = PATH( 2: 3 ) 109 DO 10 I = 1, NMAX 110 D( I ) = 1. 111 E( I ) = 2. 112 DL( I ) = 3. 113 DU( I ) = 4. 114 10 CONTINUE 115 ANORM = 1.0 116 OK = .TRUE. 117* 118 IF( LSAMEN( 2, C2, 'GT' ) ) THEN 119* 120* Test error exits for the general tridiagonal routines. 121* 122* CGTTRF 123* 124 SRNAMT = 'CGTTRF' 125 INFOT = 1 126 CALL CGTTRF( -1, DL, E, DU, DU2, IP, INFO ) 127 CALL CHKXER( 'CGTTRF', INFOT, NOUT, LERR, OK ) 128* 129* CGTTRS 130* 131 SRNAMT = 'CGTTRS' 132 INFOT = 1 133 CALL CGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO ) 134 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 135 INFOT = 2 136 CALL CGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO ) 137 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 138 INFOT = 3 139 CALL CGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO ) 140 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 141 INFOT = 10 142 CALL CGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO ) 143 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 144* 145* CGTRFS 146* 147 SRNAMT = 'CGTRFS' 148 INFOT = 1 149 CALL CGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1, 150 $ X, 1, R1, R2, W, RW, INFO ) 151 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL CGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 154 $ 1, X, 1, R1, R2, W, RW, INFO ) 155 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 156 INFOT = 3 157 CALL CGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 158 $ 1, X, 1, R1, R2, W, RW, INFO ) 159 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 160 INFOT = 13 161 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1, 162 $ X, 2, R1, R2, W, RW, INFO ) 163 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 164 INFOT = 15 165 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2, 166 $ X, 1, R1, R2, W, RW, INFO ) 167 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 168* 169* CGTCON 170* 171 SRNAMT = 'CGTCON' 172 INFOT = 1 173 CALL CGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W, 174 $ INFO ) 175 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK ) 176 INFOT = 2 177 CALL CGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W, 178 $ INFO ) 179 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK ) 180 INFOT = 8 181 CALL CGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W, 182 $ INFO ) 183 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK ) 184* 185 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN 186* 187* Test error exits for the positive definite tridiagonal 188* routines. 189* 190* CPTTRF 191* 192 SRNAMT = 'CPTTRF' 193 INFOT = 1 194 CALL CPTTRF( -1, D, E, INFO ) 195 CALL CHKXER( 'CPTTRF', INFOT, NOUT, LERR, OK ) 196* 197* CPTTRS 198* 199 SRNAMT = 'CPTTRS' 200 INFOT = 1 201 CALL CPTTRS( '/', 1, 0, D, E, X, 1, INFO ) 202 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 203 INFOT = 2 204 CALL CPTTRS( 'U', -1, 0, D, E, X, 1, INFO ) 205 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 206 INFOT = 3 207 CALL CPTTRS( 'U', 0, -1, D, E, X, 1, INFO ) 208 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 209 INFOT = 7 210 CALL CPTTRS( 'U', 2, 1, D, E, X, 1, INFO ) 211 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 212* 213* CPTRFS 214* 215 SRNAMT = 'CPTRFS' 216 INFOT = 1 217 CALL CPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 218 $ RW, INFO ) 219 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 220 INFOT = 2 221 CALL CPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 222 $ RW, INFO ) 223 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 224 INFOT = 3 225 CALL CPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 226 $ RW, INFO ) 227 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 228 INFOT = 9 229 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, 230 $ RW, INFO ) 231 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 232 INFOT = 11 233 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, 234 $ RW, INFO ) 235 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 236* 237* CPTCON 238* 239 SRNAMT = 'CPTCON' 240 INFOT = 1 241 CALL CPTCON( -1, D, E, ANORM, RCOND, RW, INFO ) 242 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK ) 243 INFOT = 4 244 CALL CPTCON( 0, D, E, -ANORM, RCOND, RW, INFO ) 245 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK ) 246 END IF 247* 248* Print a summary line. 249* 250 CALL ALAESM( PATH, OK, NOUT ) 251* 252 RETURN 253* 254* End of CERRGT 255* 256 END 257