LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ derrgt()

subroutine derrgt ( character*3  PATH,
integer  NUNIT 
)

DERRGT

Purpose:
 DERRGT tests the error exits for the DOUBLE PRECISION 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 derrgt.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 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 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
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
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
dgttrf
subroutine dgttrf(N, DL, D, DU, DU2, IPIV, INFO)
DGTTRF
Definition: dgttrf.f:124
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
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
Here is the call graph for this function:
Here is the caller graph for this function: