|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CERRGT( PATH, NUNIT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * CERRGT tests the error exits for the COMPLEX tridiagonal 00016 * routines. 00017 * 00018 * Arguments 00019 * ========= 00020 * 00021 * PATH (input) CHARACTER*3 00022 * The LAPACK path name for the routines to be tested. 00023 * 00024 * NUNIT (input) INTEGER 00025 * The unit number for output. 00026 * 00027 * ===================================================================== 00028 * 00029 * .. Parameters .. 00030 INTEGER NMAX 00031 PARAMETER ( NMAX = 2 ) 00032 * .. 00033 * .. Local Scalars .. 00034 CHARACTER*2 C2 00035 INTEGER I, INFO 00036 REAL ANORM, RCOND 00037 * .. 00038 * .. Local Arrays .. 00039 INTEGER IP( NMAX ) 00040 REAL D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ), 00041 $ RW( NMAX ) 00042 COMPLEX B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ), 00043 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ), 00044 $ EF( NMAX ), W( NMAX ), X( NMAX ) 00045 * .. 00046 * .. External Functions .. 00047 LOGICAL LSAMEN 00048 EXTERNAL LSAMEN 00049 * .. 00050 * .. External Subroutines .. 00051 EXTERNAL ALAESM, CGTCON, CGTRFS, CGTTRF, CGTTRS, CHKXER, 00052 $ CPTCON, CPTRFS, CPTTRF, CPTTRS 00053 * .. 00054 * .. Scalars in Common .. 00055 LOGICAL LERR, OK 00056 CHARACTER*32 SRNAMT 00057 INTEGER INFOT, NOUT 00058 * .. 00059 * .. Common blocks .. 00060 COMMON / INFOC / INFOT, NOUT, OK, LERR 00061 COMMON / SRNAMC / SRNAMT 00062 * .. 00063 * .. Executable Statements .. 00064 * 00065 NOUT = NUNIT 00066 WRITE( NOUT, FMT = * ) 00067 C2 = PATH( 2: 3 ) 00068 DO 10 I = 1, NMAX 00069 D( I ) = 1. 00070 E( I ) = 2. 00071 DL( I ) = 3. 00072 DU( I ) = 4. 00073 10 CONTINUE 00074 ANORM = 1.0 00075 OK = .TRUE. 00076 * 00077 IF( LSAMEN( 2, C2, 'GT' ) ) THEN 00078 * 00079 * Test error exits for the general tridiagonal routines. 00080 * 00081 * CGTTRF 00082 * 00083 SRNAMT = 'CGTTRF' 00084 INFOT = 1 00085 CALL CGTTRF( -1, DL, E, DU, DU2, IP, INFO ) 00086 CALL CHKXER( 'CGTTRF', INFOT, NOUT, LERR, OK ) 00087 * 00088 * CGTTRS 00089 * 00090 SRNAMT = 'CGTTRS' 00091 INFOT = 1 00092 CALL CGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO ) 00093 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 00094 INFOT = 2 00095 CALL CGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO ) 00096 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 00097 INFOT = 3 00098 CALL CGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO ) 00099 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 00100 INFOT = 10 00101 CALL CGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO ) 00102 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK ) 00103 * 00104 * CGTRFS 00105 * 00106 SRNAMT = 'CGTRFS' 00107 INFOT = 1 00108 CALL CGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1, 00109 $ X, 1, R1, R2, W, RW, INFO ) 00110 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 00111 INFOT = 2 00112 CALL CGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 00113 $ 1, X, 1, R1, R2, W, RW, INFO ) 00114 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 00115 INFOT = 3 00116 CALL CGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 00117 $ 1, X, 1, R1, R2, W, RW, INFO ) 00118 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 00119 INFOT = 13 00120 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1, 00121 $ X, 2, R1, R2, W, RW, INFO ) 00122 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 00123 INFOT = 15 00124 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2, 00125 $ X, 1, R1, R2, W, RW, INFO ) 00126 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK ) 00127 * 00128 * CGTCON 00129 * 00130 SRNAMT = 'CGTCON' 00131 INFOT = 1 00132 CALL CGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W, 00133 $ INFO ) 00134 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK ) 00135 INFOT = 2 00136 CALL CGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W, 00137 $ INFO ) 00138 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK ) 00139 INFOT = 8 00140 CALL CGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W, 00141 $ INFO ) 00142 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK ) 00143 * 00144 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN 00145 * 00146 * Test error exits for the positive definite tridiagonal 00147 * routines. 00148 * 00149 * CPTTRF 00150 * 00151 SRNAMT = 'CPTTRF' 00152 INFOT = 1 00153 CALL CPTTRF( -1, D, E, INFO ) 00154 CALL CHKXER( 'CPTTRF', INFOT, NOUT, LERR, OK ) 00155 * 00156 * CPTTRS 00157 * 00158 SRNAMT = 'CPTTRS' 00159 INFOT = 1 00160 CALL CPTTRS( '/', 1, 0, D, E, X, 1, INFO ) 00161 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 00162 INFOT = 2 00163 CALL CPTTRS( 'U', -1, 0, D, E, X, 1, INFO ) 00164 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 00165 INFOT = 3 00166 CALL CPTTRS( 'U', 0, -1, D, E, X, 1, INFO ) 00167 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 00168 INFOT = 7 00169 CALL CPTTRS( 'U', 2, 1, D, E, X, 1, INFO ) 00170 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK ) 00171 * 00172 * CPTRFS 00173 * 00174 SRNAMT = 'CPTRFS' 00175 INFOT = 1 00176 CALL CPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 00177 $ RW, INFO ) 00178 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 00179 INFOT = 2 00180 CALL CPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 00181 $ RW, INFO ) 00182 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 00183 INFOT = 3 00184 CALL CPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 00185 $ RW, INFO ) 00186 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 00187 INFOT = 9 00188 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, 00189 $ RW, INFO ) 00190 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 00191 INFOT = 11 00192 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, 00193 $ RW, INFO ) 00194 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK ) 00195 * 00196 * CPTCON 00197 * 00198 SRNAMT = 'CPTCON' 00199 INFOT = 1 00200 CALL CPTCON( -1, D, E, ANORM, RCOND, RW, INFO ) 00201 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK ) 00202 INFOT = 4 00203 CALL CPTCON( 0, D, E, -ANORM, RCOND, RW, INFO ) 00204 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK ) 00205 END IF 00206 * 00207 * Print a summary line. 00208 * 00209 CALL ALAESM( PATH, OK, NOUT ) 00210 * 00211 RETURN 00212 * 00213 * End of CERRGT 00214 * 00215 END
1.7.3 
