OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrgt.f
Go to the documentation of this file.
1*> \brief \b DERRGT
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 DERRGT( 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*> DERRGT tests the error exits for the DOUBLE PRECISION 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 double_lin
52*
53* =====================================================================
54 SUBROUTINE derrgt( 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 INFO
74 DOUBLE PRECISION ANORM, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX ), IW( NMAX )
78 DOUBLE PRECISION B( NMAX ), C( NMAX ), CF( NMAX ), D( NMAX ),
79 $ DF( NMAX ), E( NMAX ), EF( NMAX ), F( NMAX ),
80 $ R1( NMAX ), R2( NMAX ), W( NMAX ), X( NMAX )
81* ..
82* .. External Functions ..
83 LOGICAL LSAMEN
84 EXTERNAL lsamen
85* ..
86* .. External Subroutines ..
87 EXTERNAL alaesm, chkxer, dgtcon, dgtrfs, dgttrf, dgttrs,
88 $ dptcon, dptrfs, dpttrf, dpttrs
89* ..
90* .. Scalars in Common ..
91 LOGICAL LERR, OK
92 CHARACTER*32 SRNAMT
93 INTEGER INFOT, NOUT
94* ..
95* .. Common blocks ..
96 COMMON / infoc / infot, nout, ok, lerr
97 COMMON / srnamc / srnamt
98* ..
99* .. Executable Statements ..
100*
101 nout = nunit
102 WRITE( nout, fmt = * )
103 c2 = path( 2: 3 )
104 d( 1 ) = 1.d0
105 d( 2 ) = 2.d0
106 df( 1 ) = 1.d0
107 df( 2 ) = 2.d0
108 e( 1 ) = 3.d0
109 e( 2 ) = 4.d0
110 ef( 1 ) = 3.d0
111 ef( 2 ) = 4.d0
112 anorm = 1.0d0
113 ok = .true.
114*
115 IF( lsamen( 2, c2, 'GT' ) ) THEN
116*
117* Test error exits for the general tridiagonal routines.
118*
119* DGTTRF
120*
121 srnamt = 'DGTTRF'
122 infot = 1
123 CALL dgttrf( -1, c, d, e, f, ip, info )
124 CALL chkxer( 'DGTTRF', infot, nout, lerr, ok )
125*
126* DGTTRS
127*
128 srnamt = 'DGTTRS'
129 infot = 1
130 CALL dgttrs( '/', 0, 0, c, d, e, f, ip, x, 1, info )
131 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
132 infot = 2
133 CALL dgttrs( 'N', -1, 0, c, d, e, f, ip, x, 1, info )
134 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
135 infot = 3
136 CALL dgttrs( 'N', 0, -1, c, d, e, f, ip, x, 1, info )
137 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
138 infot = 10
139 CALL dgttrs( 'N', 2, 1, c, d, e, f, ip, x, 1, info )
140 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
141*
142* DGTRFS
143*
144 srnamt = 'DGTRFS'
145 infot = 1
146 CALL dgtrfs( '/', 0, 0, c, d, e, cf, df, ef, f, ip, b, 1, x, 1,
147 $ r1, r2, w, iw, info )
148 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
149 infot = 2
150 CALL dgtrfs( 'N', -1, 0, c, d, e, cf, df, ef, f, ip, b, 1, x,
151 $ 1, r1, r2, w, iw, info )
152 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
153 infot = 3
154 CALL dgtrfs( 'N', 0, -1, c, d, e, cf, df, ef, f, ip, b, 1, x,
155 $ 1, r1, r2, w, iw, info )
156 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
157 infot = 13
158 CALL dgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 1, x, 2,
159 $ r1, r2, w, iw, info )
160 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
161 infot = 15
162 CALL dgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 2, x, 1,
163 $ r1, r2, w, iw, info )
164 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
165*
166* DGTCON
167*
168 srnamt = 'DGTCON'
169 infot = 1
170 CALL dgtcon( '/', 0, c, d, e, f, ip, anorm, rcond, w, iw,
171 $ info )
172 CALL chkxer( 'DGTCON', infot, nout, lerr, ok )
173 infot = 2
174 CALL dgtcon( 'I', -1, c, d, e, f, ip, anorm, rcond, w, iw,
175 $ info )
176 CALL chkxer( 'DGTCON', infot, nout, lerr, ok )
177 infot = 8
178 CALL dgtcon( 'I', 0, c, d, e, f, ip, -anorm, rcond, w, iw,
179 $ info )
180 CALL chkxer( 'DGTCON', 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* DPTTRF
188*
189 srnamt = 'DPTTRF'
190 infot = 1
191 CALL dpttrf( -1, d, e, info )
192 CALL chkxer( 'DPTTRF', infot, nout, lerr, ok )
193*
194* DPTTRS
195*
196 srnamt = 'DPTTRS'
197 infot = 1
198 CALL dpttrs( -1, 0, d, e, x, 1, info )
199 CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
200 infot = 2
201 CALL dpttrs( 0, -1, d, e, x, 1, info )
202 CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
203 infot = 6
204 CALL dpttrs( 2, 1, d, e, x, 1, info )
205 CALL chkxer( 'dpttrs', INFOT, NOUT, LERR, OK )
206*
207* DPTRFS
208*
209 SRNAMT = 'dptrfs'
210 INFOT = 1
211 CALL DPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
212 CALL CHKXER( 'dptrfs', INFOT, NOUT, LERR, OK )
213 INFOT = 2
214 CALL DPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
215 CALL CHKXER( 'dptrfs', INFOT, NOUT, LERR, OK )
216 INFOT = 8
217 CALL DPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO )
218 CALL CHKXER( 'dptrfs', INFOT, NOUT, LERR, OK )
219 INFOT = 10
220 CALL DPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO )
221 CALL CHKXER( 'dptrfs', INFOT, NOUT, LERR, OK )
222*
223* DPTCON
224*
225 SRNAMT = 'dptcon'
226 INFOT = 1
227 CALL DPTCON( -1, D, E, ANORM, RCOND, W, INFO )
228 CALL CHKXER( 'dptcon', INFOT, NOUT, LERR, OK )
229 INFOT = 4
230 CALL DPTCON( 0, D, E, -ANORM, RCOND, W, INFO )
231 CALL CHKXER( 'dptcon', INFOT, NOUT, LERR, OK )
232 END IF
233*
234* Print a summary line.
235*
236 CALL ALAESM( PATH, OK, NOUT )
237*
238 RETURN
239*
240* End of DERRGT
241*
242 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
dgtcon
subroutine dgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork, info)
DGTCON
Definition dgtcon.f:146
dgttrs
subroutine dgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
DGTTRS
Definition dgttrs.f:138
dgtrfs
subroutine dgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DGTRFS
Definition dgtrfs.f:209
dgttrf
subroutine dgttrf(n, dl, d, du, du2, ipiv, info)
DGTTRF
Definition dgttrf.f:124
dpttrf
subroutine dpttrf(n, d, e, info)
DPTTRF
Definition dpttrf.f:91
dpttrs
subroutine dpttrs(n, nrhs, d, e, b, ldb, info)
DPTTRS
Definition dpttrs.f:109
dptrfs
subroutine dptrfs(n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, info)
DPTRFS
Definition dptrfs.f:163
dptcon
subroutine dptcon(n, d, e, anorm, rcond, work, info)
DPTCON
Definition dptcon.f:118
derrgt
subroutine derrgt(path, nunit)
DERRGT
Definition derrgt.f:55