55
56
57
58
59
60
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63
64
65
66
67
68 INTEGER NMAX
69 parameter( nmax = 2 )
70
71
72 CHARACTER*2 C2
73 INTEGER I, INFO
74 REAL ANORM, RCOND
75
76
77 INTEGER IP( NMAX )
78 REAL D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
79 $ RW( NMAX )
80 COMPLEX B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ),
81 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ),
82 $ EF( NMAX ), W( NMAX ), X( NMAX )
83
84
85 LOGICAL LSAMEN
87
88
91
92
93 LOGICAL LERR, OK
94 CHARACTER*32 SRNAMT
95 INTEGER INFOT, NOUT
96
97
98 COMMON / infoc / infot, nout, ok, lerr
99 COMMON / srnamc / srnamt
100
101
102
103 nout = nunit
104 WRITE( nout, fmt = * )
105 c2 = path( 2: 3 )
106 DO 10 i = 1, nmax
107 d( i ) = 1.
108 e( i ) = 2.
109 dl( i ) = 3.
110 du( i ) = 4.
111 10 CONTINUE
112 anorm = 1.0
113 ok = .true.
114
115 IF(
lsamen( 2, c2,
'GT' ) )
THEN
116
117
118
119
120
121 srnamt = 'CGTTRF'
122 infot = 1
123 CALL cgttrf( -1, dl, e, du, du2, ip, info )
124 CALL chkxer(
'CGTTRF', infot, nout, lerr, ok )
125
126
127
128 srnamt = 'CGTTRS'
129 infot = 1
130 CALL cgttrs(
'/', 0, 0, dl, e, du, du2, ip, x, 1, info )
131 CALL chkxer(
'CGTTRS', infot, nout, lerr, ok )
132 infot = 2
133 CALL cgttrs(
'N', -1, 0, dl, e, du, du2, ip, x, 1, info )
134 CALL chkxer(
'CGTTRS', infot, nout, lerr, ok )
135 infot = 3
136 CALL cgttrs(
'N', 0, -1, dl, e, du, du2, ip, x, 1, info )
137 CALL chkxer(
'CGTTRS', infot, nout, lerr, ok )
138 infot = 10
139 CALL cgttrs(
'N', 2, 1, dl, e, du, du2, ip, x, 1, info )
140 CALL chkxer(
'CGTTRS', infot, nout, lerr, ok )
141
142
143
144 srnamt = 'CGTRFS'
145 infot = 1
146 CALL cgtrfs(
'/', 0, 0, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
147 $ x, 1, r1, r2, w, rw, info )
148 CALL chkxer(
'CGTRFS', infot, nout, lerr, ok )
149 infot = 2
150 CALL cgtrfs(
'N', -1, 0, dl, e, du, dlf, ef, duf, du2, ip, b,
151 $ 1, x, 1, r1, r2, w, rw, info )
152 CALL chkxer(
'CGTRFS', infot, nout, lerr, ok )
153 infot = 3
154 CALL cgtrfs(
'N', 0, -1, dl, e, du, dlf, ef, duf, du2, ip, b,
155 $ 1, x, 1, r1, r2, w, rw, info )
156 CALL chkxer(
'CGTRFS', infot, nout, lerr, ok )
157 infot = 13
158 CALL cgtrfs(
'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
159 $ x, 2, r1, r2, w, rw, info )
160 CALL chkxer(
'CGTRFS', infot, nout, lerr, ok )
161 infot = 15
162 CALL cgtrfs(
'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 2,
163 $ x, 1, r1, r2, w, rw, info )
164 CALL chkxer(
'CGTRFS', infot, nout, lerr, ok )
165
166
167
168 srnamt = 'CGTCON'
169 infot = 1
170 CALL cgtcon(
'/', 0, dl, e, du, du2, ip, anorm, rcond, w,
171 $ info )
172 CALL chkxer(
'CGTCON', infot, nout, lerr, ok )
173 infot = 2
174 CALL cgtcon(
'I', -1, dl, e, du, du2, ip, anorm, rcond, w,
175 $ info )
176 CALL chkxer(
'CGTCON', infot, nout, lerr, ok )
177 infot = 8
178 CALL cgtcon(
'I', 0, dl, e, du, du2, ip, -anorm, rcond, w,
179 $ info )
180 CALL chkxer(
'CGTCON', infot, nout, lerr, ok )
181
182 ELSE IF(
lsamen( 2, c2,
'PT' ) )
THEN
183
184
185
186
187
188
189 srnamt = 'CPTTRF'
190 infot = 1
191 CALL cpttrf( -1, d, e, info )
192 CALL chkxer(
'CPTTRF', infot, nout, lerr, ok )
193
194
195
196 srnamt = 'CPTTRS'
197 infot = 1
198 CALL cpttrs(
'/', 1, 0, d, e, x, 1, info )
199 CALL chkxer(
'CPTTRS', infot, nout, lerr, ok )
200 infot = 2
201 CALL cpttrs(
'U', -1, 0, d, e, x, 1, info )
202 CALL chkxer(
'CPTTRS', infot, nout, lerr, ok )
203 infot = 3
204 CALL cpttrs(
'U', 0, -1, d, e, x, 1, info )
205 CALL chkxer(
'CPTTRS', infot, nout, lerr, ok )
206 infot = 7
207 CALL cpttrs(
'U', 2, 1, d, e, x, 1, info )
208 CALL chkxer(
'CPTTRS', infot, nout, lerr, ok )
209
210
211
212 srnamt = 'CPTRFS'
213 infot = 1
214 CALL cptrfs(
'/', 1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
215 $ rw, info )
216 CALL chkxer(
'CPTRFS', infot, nout, lerr, ok )
217 infot = 2
218 CALL cptrfs(
'U', -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
219 $ rw, info )
220 CALL chkxer(
'CPTRFS', infot, nout, lerr, ok )
221 infot = 3
222 CALL cptrfs(
'U', 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w,
223 $ rw, info )
224 CALL chkxer(
'CPTRFS', infot, nout, lerr, ok )
225 infot = 9
226 CALL cptrfs(
'U', 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w,
227 $ rw, info )
228 CALL chkxer(
'CPTRFS', infot, nout, lerr, ok )
229 infot = 11
230 CALL cptrfs(
'U', 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w,
231 $ rw, info )
232 CALL chkxer(
'CPTRFS', infot, nout, lerr, ok )
233
234
235
236 srnamt = 'CPTCON'
237 infot = 1
238 CALL cptcon( -1, d, e, anorm, rcond, rw, info )
239 CALL chkxer(
'CPTCON', infot, nout, lerr, ok )
240 infot = 4
241 CALL cptcon( 0, d, e, -anorm, rcond, rw, info )
242 CALL chkxer(
'CPTCON', infot, nout, lerr, ok )
243 END IF
244
245
246
247 CALL alaesm( path, ok, nout )
248
249 RETURN
250
251
252
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, info)
CGTCON
subroutine cgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGTRFS
subroutine cgttrf(n, dl, d, du, du2, ipiv, info)
CGTTRF
subroutine cgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
CGTTRS
logical function lsamen(n, ca, cb)
LSAMEN
subroutine cptcon(n, d, e, anorm, rcond, rwork, info)
CPTCON
subroutine cptrfs(uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPTRFS
subroutine cpttrf(n, d, e, info)
CPTTRF
subroutine cpttrs(uplo, n, nrhs, d, e, b, ldb, info)
CPTTRS