OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cerrgt.f
Go to the documentation of this file.
1*> \brief \b CERRGT
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CERRGT( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> CERRGT tests the error exits for the COMPLEX tridiagonal
25*> routines.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup complex_lin
52*
53* =====================================================================
54 SUBROUTINE cerrgt( PATH, NUNIT )
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,
90 $ cptcon, cptrfs, cpttrf, cpttrs
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*
253 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
cgttrf
subroutine cgttrf(n, dl, d, du, du2, ipiv, info)
CGTTRF
Definition cgttrf.f:124
cgttrs
subroutine cgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
CGTTRS
Definition cgttrs.f:138
cgtcon
subroutine cgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, info)
CGTCON
Definition cgtcon.f:141
cgtrfs
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
cptrfs
subroutine cptrfs(uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPTRFS
Definition cptrfs.f:183
cpttrf
subroutine cpttrf(n, d, e, info)
CPTTRF
Definition cpttrf.f:92
cpttrs
subroutine cpttrs(uplo, n, nrhs, d, e, b, ldb, info)
CPTTRS
Definition cpttrs.f:121
cptcon
subroutine cptcon(n, d, e, anorm, rcond, rwork, info)
CPTCON
Definition cptcon.f:119
cerrgt
subroutine cerrgt(path, nunit)
CERRGT
Definition cerrgt.f:55