LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cerrgt()

subroutine cerrgt ( character*3  path,
integer  nunit 
)

CERRGT

Purpose:
 CERRGT tests the error exits for the COMPLEX tridiagonal
 routines.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file cerrgt.f.

55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX
69 parameter( nmax = 2 )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, INFO
74 REAL ANORM, RCOND
75* ..
76* .. Local Arrays ..
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* .. External Functions ..
85 LOGICAL LSAMEN
86 EXTERNAL lsamen
87* ..
88* .. External Subroutines ..
89 EXTERNAL alaesm, cgtcon, cgtrfs, cgttrf, cgttrs, chkxer,
91* ..
92* .. Scalars in Common ..
93 LOGICAL LERR, OK
94 CHARACTER*32 SRNAMT
95 INTEGER INFOT, NOUT
96* ..
97* .. Common blocks ..
98 COMMON / infoc / infot, nout, ok, lerr
99 COMMON / srnamc / srnamt
100* ..
101* .. Executable Statements ..
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* Test error exits for the general tridiagonal routines.
118*
119* CGTTRF
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* CGTTRS
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* CGTRFS
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* CGTCON
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* Test error exits for the positive definite tridiagonal
185* routines.
186*
187* CPTTRF
188*
189 srnamt = 'CPTTRF'
190 infot = 1
191 CALL cpttrf( -1, d, e, info )
192 CALL chkxer( 'CPTTRF', infot, nout, lerr, ok )
193*
194* CPTTRS
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* CPTRFS
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* CPTCON
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* Print a summary line.
246*
247 CALL alaesm( path, ok, nout )
248*
249 RETURN
250*
251* End of CERRGT
252*
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine cgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, info)
CGTCON
Definition cgtcon.f:141
subroutine cgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGTRFS
Definition cgtrfs.f:210
subroutine cgttrf(n, dl, d, du, du2, ipiv, info)
CGTTRF
Definition cgttrf.f:124
subroutine cgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
CGTTRS
Definition cgttrs.f:138
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
subroutine cptcon(n, d, e, anorm, rcond, rwork, info)
CPTCON
Definition cptcon.f:119
subroutine cptrfs(uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPTRFS
Definition cptrfs.f:183
subroutine cpttrf(n, d, e, info)
CPTTRF
Definition cpttrf.f:92
subroutine cpttrs(uplo, n, nrhs, d, e, b, ldb, info)
CPTTRS
Definition cpttrs.f:121
Here is the call graph for this function:
Here is the caller graph for this function: