00001 SUBROUTINE ZERRGT( PATH, NUNIT )
00002
00003
00004
00005
00006
00007
00008 CHARACTER*3 PATH
00009 INTEGER NUNIT
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030 INTEGER NMAX
00031 PARAMETER ( NMAX = 2 )
00032
00033
00034 CHARACTER*2 C2
00035 INTEGER I, INFO
00036 DOUBLE PRECISION ANORM, RCOND
00037
00038
00039 INTEGER IP( NMAX )
00040 DOUBLE PRECISION D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
00041 $ RW( NMAX )
00042 COMPLEX*16 B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ),
00043 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ),
00044 $ EF( NMAX ), W( NMAX ), X( NMAX )
00045
00046
00047 LOGICAL LSAMEN
00048 EXTERNAL LSAMEN
00049
00050
00051 EXTERNAL ALAESM, CHKXER, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS,
00052 $ ZPTCON, ZPTRFS, ZPTTRF, ZPTTRS
00053
00054
00055 LOGICAL LERR, OK
00056 CHARACTER*32 SRNAMT
00057 INTEGER INFOT, NOUT
00058
00059
00060 COMMON / INFOC / INFOT, NOUT, OK, LERR
00061 COMMON / SRNAMC / SRNAMT
00062
00063
00064
00065 NOUT = NUNIT
00066 WRITE( NOUT, FMT = * )
00067 C2 = PATH( 2: 3 )
00068 DO 10 I = 1, NMAX
00069 D( I ) = 1.D0
00070 E( I ) = 2.D0
00071 DL( I ) = 3.D0
00072 DU( I ) = 4.D0
00073 10 CONTINUE
00074 ANORM = 1.0D0
00075 OK = .TRUE.
00076
00077 IF( LSAMEN( 2, C2, 'GT' ) ) THEN
00078
00079
00080
00081
00082
00083 SRNAMT = 'ZGTTRF'
00084 INFOT = 1
00085 CALL ZGTTRF( -1, DL, E, DU, DU2, IP, INFO )
00086 CALL CHKXER( 'ZGTTRF', INFOT, NOUT, LERR, OK )
00087
00088
00089
00090 SRNAMT = 'ZGTTRS'
00091 INFOT = 1
00092 CALL ZGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO )
00093 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
00094 INFOT = 2
00095 CALL ZGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO )
00096 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
00097 INFOT = 3
00098 CALL ZGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO )
00099 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
00100 INFOT = 10
00101 CALL ZGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO )
00102 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
00103
00104
00105
00106 SRNAMT = 'ZGTRFS'
00107 INFOT = 1
00108 CALL ZGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
00109 $ X, 1, R1, R2, W, RW, INFO )
00110 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
00111 INFOT = 2
00112 CALL ZGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
00113 $ 1, X, 1, R1, R2, W, RW, INFO )
00114 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
00115 INFOT = 3
00116 CALL ZGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
00117 $ 1, X, 1, R1, R2, W, RW, INFO )
00118 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
00119 INFOT = 13
00120 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
00121 $ X, 2, R1, R2, W, RW, INFO )
00122 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
00123 INFOT = 15
00124 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2,
00125 $ X, 1, R1, R2, W, RW, INFO )
00126 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
00127
00128
00129
00130 SRNAMT = 'ZGTCON'
00131 INFOT = 1
00132 CALL ZGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W,
00133 $ INFO )
00134 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
00135 INFOT = 2
00136 CALL ZGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W,
00137 $ INFO )
00138 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
00139 INFOT = 8
00140 CALL ZGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W,
00141 $ INFO )
00142 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
00143
00144 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
00145
00146
00147
00148
00149
00150
00151 SRNAMT = 'ZPTTRF'
00152 INFOT = 1
00153 CALL ZPTTRF( -1, D, E, INFO )
00154 CALL CHKXER( 'ZPTTRF', INFOT, NOUT, LERR, OK )
00155
00156
00157
00158 SRNAMT = 'ZPTTRS'
00159 INFOT = 1
00160 CALL ZPTTRS( '/', 1, 0, D, E, X, 1, INFO )
00161 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
00162 INFOT = 2
00163 CALL ZPTTRS( 'U', -1, 0, D, E, X, 1, INFO )
00164 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
00165 INFOT = 3
00166 CALL ZPTTRS( 'U', 0, -1, D, E, X, 1, INFO )
00167 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
00168 INFOT = 7
00169 CALL ZPTTRS( 'U', 2, 1, D, E, X, 1, INFO )
00170 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
00171
00172
00173
00174 SRNAMT = 'ZPTRFS'
00175 INFOT = 1
00176 CALL ZPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
00177 $ RW, INFO )
00178 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
00179 INFOT = 2
00180 CALL ZPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
00181 $ RW, INFO )
00182 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
00183 INFOT = 3
00184 CALL ZPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
00185 $ RW, INFO )
00186 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
00187 INFOT = 9
00188 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W,
00189 $ RW, INFO )
00190 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
00191 INFOT = 11
00192 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W,
00193 $ RW, INFO )
00194 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
00195
00196
00197
00198 SRNAMT = 'ZPTCON'
00199 INFOT = 1
00200 CALL ZPTCON( -1, D, E, ANORM, RCOND, RW, INFO )
00201 CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK )
00202 INFOT = 4
00203 CALL ZPTCON( 0, D, E, -ANORM, RCOND, RW, INFO )
00204 CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK )
00205 END IF
00206
00207
00208
00209 CALL ALAESM( PATH, OK, NOUT )
00210
00211 RETURN
00212
00213
00214
00215 END