![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZERRGT 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ZERRGT( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> ZERRGT tests the error exits for the COMPLEX*16 tridiagonal 00025 *> routines. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup complex16_lin 00054 * 00055 * ===================================================================== 00056 SUBROUTINE ZERRGT( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX 00072 PARAMETER ( NMAX = 2 ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, INFO 00077 DOUBLE PRECISION ANORM, RCOND 00078 * .. 00079 * .. Local Arrays .. 00080 INTEGER IP( NMAX ) 00081 DOUBLE PRECISION D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ), 00082 $ RW( NMAX ) 00083 COMPLEX*16 B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ), 00084 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ), 00085 $ EF( NMAX ), W( NMAX ), X( NMAX ) 00086 * .. 00087 * .. External Functions .. 00088 LOGICAL LSAMEN 00089 EXTERNAL LSAMEN 00090 * .. 00091 * .. External Subroutines .. 00092 EXTERNAL ALAESM, CHKXER, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS, 00093 $ ZPTCON, ZPTRFS, ZPTTRF, ZPTTRS 00094 * .. 00095 * .. Scalars in Common .. 00096 LOGICAL LERR, OK 00097 CHARACTER*32 SRNAMT 00098 INTEGER INFOT, NOUT 00099 * .. 00100 * .. Common blocks .. 00101 COMMON / INFOC / INFOT, NOUT, OK, LERR 00102 COMMON / SRNAMC / SRNAMT 00103 * .. 00104 * .. Executable Statements .. 00105 * 00106 NOUT = NUNIT 00107 WRITE( NOUT, FMT = * ) 00108 C2 = PATH( 2: 3 ) 00109 DO 10 I = 1, NMAX 00110 D( I ) = 1.D0 00111 E( I ) = 2.D0 00112 DL( I ) = 3.D0 00113 DU( I ) = 4.D0 00114 10 CONTINUE 00115 ANORM = 1.0D0 00116 OK = .TRUE. 00117 * 00118 IF( LSAMEN( 2, C2, 'GT' ) ) THEN 00119 * 00120 * Test error exits for the general tridiagonal routines. 00121 * 00122 * ZGTTRF 00123 * 00124 SRNAMT = 'ZGTTRF' 00125 INFOT = 1 00126 CALL ZGTTRF( -1, DL, E, DU, DU2, IP, INFO ) 00127 CALL CHKXER( 'ZGTTRF', INFOT, NOUT, LERR, OK ) 00128 * 00129 * ZGTTRS 00130 * 00131 SRNAMT = 'ZGTTRS' 00132 INFOT = 1 00133 CALL ZGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO ) 00134 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK ) 00135 INFOT = 2 00136 CALL ZGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO ) 00137 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK ) 00138 INFOT = 3 00139 CALL ZGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO ) 00140 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK ) 00141 INFOT = 10 00142 CALL ZGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO ) 00143 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK ) 00144 * 00145 * ZGTRFS 00146 * 00147 SRNAMT = 'ZGTRFS' 00148 INFOT = 1 00149 CALL ZGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1, 00150 $ X, 1, R1, R2, W, RW, INFO ) 00151 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK ) 00152 INFOT = 2 00153 CALL ZGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 00154 $ 1, X, 1, R1, R2, W, RW, INFO ) 00155 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK ) 00156 INFOT = 3 00157 CALL ZGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 00158 $ 1, X, 1, R1, R2, W, RW, INFO ) 00159 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK ) 00160 INFOT = 13 00161 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1, 00162 $ X, 2, R1, R2, W, RW, INFO ) 00163 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK ) 00164 INFOT = 15 00165 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2, 00166 $ X, 1, R1, R2, W, RW, INFO ) 00167 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK ) 00168 * 00169 * ZGTCON 00170 * 00171 SRNAMT = 'ZGTCON' 00172 INFOT = 1 00173 CALL ZGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W, 00174 $ INFO ) 00175 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK ) 00176 INFOT = 2 00177 CALL ZGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W, 00178 $ INFO ) 00179 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK ) 00180 INFOT = 8 00181 CALL ZGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W, 00182 $ INFO ) 00183 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK ) 00184 * 00185 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN 00186 * 00187 * Test error exits for the positive definite tridiagonal 00188 * routines. 00189 * 00190 * ZPTTRF 00191 * 00192 SRNAMT = 'ZPTTRF' 00193 INFOT = 1 00194 CALL ZPTTRF( -1, D, E, INFO ) 00195 CALL CHKXER( 'ZPTTRF', INFOT, NOUT, LERR, OK ) 00196 * 00197 * ZPTTRS 00198 * 00199 SRNAMT = 'ZPTTRS' 00200 INFOT = 1 00201 CALL ZPTTRS( '/', 1, 0, D, E, X, 1, INFO ) 00202 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK ) 00203 INFOT = 2 00204 CALL ZPTTRS( 'U', -1, 0, D, E, X, 1, INFO ) 00205 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK ) 00206 INFOT = 3 00207 CALL ZPTTRS( 'U', 0, -1, D, E, X, 1, INFO ) 00208 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK ) 00209 INFOT = 7 00210 CALL ZPTTRS( 'U', 2, 1, D, E, X, 1, INFO ) 00211 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK ) 00212 * 00213 * ZPTRFS 00214 * 00215 SRNAMT = 'ZPTRFS' 00216 INFOT = 1 00217 CALL ZPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 00218 $ RW, INFO ) 00219 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK ) 00220 INFOT = 2 00221 CALL ZPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 00222 $ RW, INFO ) 00223 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK ) 00224 INFOT = 3 00225 CALL ZPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, 00226 $ RW, INFO ) 00227 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK ) 00228 INFOT = 9 00229 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, 00230 $ RW, INFO ) 00231 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK ) 00232 INFOT = 11 00233 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, 00234 $ RW, INFO ) 00235 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK ) 00236 * 00237 * ZPTCON 00238 * 00239 SRNAMT = 'ZPTCON' 00240 INFOT = 1 00241 CALL ZPTCON( -1, D, E, ANORM, RCOND, RW, INFO ) 00242 CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK ) 00243 INFOT = 4 00244 CALL ZPTCON( 0, D, E, -ANORM, RCOND, RW, INFO ) 00245 CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK ) 00246 END IF 00247 * 00248 * Print a summary line. 00249 * 00250 CALL ALAESM( PATH, OK, NOUT ) 00251 * 00252 RETURN 00253 * 00254 * End of ZERRGT 00255 * 00256 END