1*> \brief \b SERRGT 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 SERRGT( 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*> SERRGT tests the error exits for the REAL 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 December 2016 52* 53*> \ingroup single_lin 54* 55* ===================================================================== 56 SUBROUTINE SERRGT( 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 CHARACTER*2 C2 76 INTEGER INFO 77 REAL ANORM, RCOND 78* .. 79* .. Local Arrays .. 80 INTEGER IP( NMAX ), IW( NMAX ) 81 REAL B( NMAX ), C( NMAX ), CF( NMAX ), D( NMAX ), 82 $ DF( NMAX ), E( NMAX ), EF( NMAX ), F( NMAX ), 83 $ R1( NMAX ), R2( NMAX ), W( NMAX ), X( NMAX ) 84* .. 85* .. External Functions .. 86 LOGICAL LSAMEN 87 EXTERNAL LSAMEN 88* .. 89* .. External Subroutines .. 90 EXTERNAL ALAESM, CHKXER, SGTCON, SGTRFS, SGTTRF, SGTTRS, 91 $ SPTCON, SPTRFS, SPTTRF, SPTTRS 92* .. 93* .. Scalars in Common .. 94 LOGICAL LERR, OK 95 CHARACTER*32 SRNAMT 96 INTEGER INFOT, NOUT 97* .. 98* .. Common blocks .. 99 COMMON / INFOC / INFOT, NOUT, OK, LERR 100 COMMON / SRNAMC / SRNAMT 101* .. 102* .. Executable Statements .. 103* 104 NOUT = NUNIT 105 WRITE( NOUT, FMT = * ) 106 C2 = PATH( 2: 3 ) 107 D( 1 ) = 1. 108 D( 2 ) = 2. 109 DF( 1 ) = 1. 110 DF( 2 ) = 2. 111 E( 1 ) = 3. 112 E( 2 ) = 4. 113 EF( 1 ) = 3. 114 EF( 2 ) = 4. 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* SGTTRF 123* 124 SRNAMT = 'SGTTRF' 125 INFOT = 1 126 CALL SGTTRF( -1, C, D, E, F, IP, INFO ) 127 CALL CHKXER( 'SGTTRF', INFOT, NOUT, LERR, OK ) 128* 129* SGTTRS 130* 131 SRNAMT = 'SGTTRS' 132 INFOT = 1 133 CALL SGTTRS( '/', 0, 0, C, D, E, F, IP, X, 1, INFO ) 134 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK ) 135 INFOT = 2 136 CALL SGTTRS( 'N', -1, 0, C, D, E, F, IP, X, 1, INFO ) 137 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK ) 138 INFOT = 3 139 CALL SGTTRS( 'N', 0, -1, C, D, E, F, IP, X, 1, INFO ) 140 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK ) 141 INFOT = 10 142 CALL SGTTRS( 'N', 2, 1, C, D, E, F, IP, X, 1, INFO ) 143 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK ) 144* 145* SGTRFS 146* 147 SRNAMT = 'SGTRFS' 148 INFOT = 1 149 CALL SGTRFS( '/', 0, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 1, 150 $ R1, R2, W, IW, INFO ) 151 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL SGTRFS( 'N', -1, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 154 $ 1, R1, R2, W, IW, INFO ) 155 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK ) 156 INFOT = 3 157 CALL SGTRFS( 'N', 0, -1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 158 $ 1, R1, R2, W, IW, INFO ) 159 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK ) 160 INFOT = 13 161 CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 2, 162 $ R1, R2, W, IW, INFO ) 163 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK ) 164 INFOT = 15 165 CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 2, X, 1, 166 $ R1, R2, W, IW, INFO ) 167 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK ) 168* 169* SGTCON 170* 171 SRNAMT = 'SGTCON' 172 INFOT = 1 173 CALL SGTCON( '/', 0, C, D, E, F, IP, ANORM, RCOND, W, IW, 174 $ INFO ) 175 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK ) 176 INFOT = 2 177 CALL SGTCON( 'I', -1, C, D, E, F, IP, ANORM, RCOND, W, IW, 178 $ INFO ) 179 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK ) 180 INFOT = 8 181 CALL SGTCON( 'I', 0, C, D, E, F, IP, -ANORM, RCOND, W, IW, 182 $ INFO ) 183 CALL CHKXER( 'SGTCON', 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* SPTTRF 191* 192 SRNAMT = 'SPTTRF' 193 INFOT = 1 194 CALL SPTTRF( -1, D, E, INFO ) 195 CALL CHKXER( 'SPTTRF', INFOT, NOUT, LERR, OK ) 196* 197* SPTTRS 198* 199 SRNAMT = 'SPTTRS' 200 INFOT = 1 201 CALL SPTTRS( -1, 0, D, E, X, 1, INFO ) 202 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK ) 203 INFOT = 2 204 CALL SPTTRS( 0, -1, D, E, X, 1, INFO ) 205 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK ) 206 INFOT = 6 207 CALL SPTTRS( 2, 1, D, E, X, 1, INFO ) 208 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK ) 209* 210* SPTRFS 211* 212 SRNAMT = 'SPTRFS' 213 INFOT = 1 214 CALL SPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO ) 215 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK ) 216 INFOT = 2 217 CALL SPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO ) 218 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK ) 219 INFOT = 8 220 CALL SPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO ) 221 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK ) 222 INFOT = 10 223 CALL SPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO ) 224 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK ) 225* 226* SPTCON 227* 228 SRNAMT = 'SPTCON' 229 INFOT = 1 230 CALL SPTCON( -1, D, E, ANORM, RCOND, W, INFO ) 231 CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK ) 232 INFOT = 4 233 CALL SPTCON( 0, D, E, -ANORM, RCOND, W, INFO ) 234 CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK ) 235 END IF 236* 237* Print a summary line. 238* 239 CALL ALAESM( PATH, OK, NOUT ) 240* 241 RETURN 242* 243* End of SERRGT 244* 245 END 246