LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zerrgt()

subroutine zerrgt ( character*3  PATH,
integer  NUNIT 
)

ZERRGT

Purpose:
 ZERRGT tests the error exits for the COMPLEX*16 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.
Date
December 2016

Definition at line 57 of file zerrgt.f.

57 *
58 * -- LAPACK test routine (version 3.7.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * December 2016
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX
72  parameter( nmax = 2 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 C2
76  INTEGER I, INFO
77  DOUBLE PRECISION ANORM, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IP( NMAX )
81  DOUBLE PRECISION D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
82  $ RW( NMAX )
83  COMPLEX*16 B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ),
84  $ DU2( NMAX ), DUF( NMAX ), E( NMAX ),
85  $ EF( NMAX ), W( NMAX ), X( NMAX )
86 * ..
87 * .. External Functions ..
88  LOGICAL LSAMEN
89  EXTERNAL lsamen
90 * ..
91 * .. External Subroutines ..
92  EXTERNAL alaesm, chkxer, zgtcon, zgtrfs, zgttrf, zgttrs,
93  $ zptcon, zptrfs, zpttrf, zpttrs
94 * ..
95 * .. Scalars in Common ..
96  LOGICAL LERR, OK
97  CHARACTER*32 SRNAMT
98  INTEGER INFOT, NOUT
99 * ..
100 * .. Common blocks ..
101  COMMON / infoc / infot, nout, ok, lerr
102  COMMON / srnamc / srnamt
103 * ..
104 * .. Executable Statements ..
105 *
106  nout = nunit
107  WRITE( nout, fmt = * )
108  c2 = path( 2: 3 )
109  DO 10 i = 1, nmax
110  d( i ) = 1.d0
111  e( i ) = 2.d0
112  dl( i ) = 3.d0
113  du( i ) = 4.d0
114  10 CONTINUE
115  anorm = 1.0d0
116  ok = .true.
117 *
118  IF( lsamen( 2, c2, 'GT' ) ) THEN
119 *
120 * Test error exits for the general tridiagonal routines.
121 *
122 * ZGTTRF
123 *
124  srnamt = 'ZGTTRF'
125  infot = 1
126  CALL zgttrf( -1, dl, e, du, du2, ip, info )
127  CALL chkxer( 'ZGTTRF', infot, nout, lerr, ok )
128 *
129 * ZGTTRS
130 *
131  srnamt = 'ZGTTRS'
132  infot = 1
133  CALL zgttrs( '/', 0, 0, dl, e, du, du2, ip, x, 1, info )
134  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
135  infot = 2
136  CALL zgttrs( 'N', -1, 0, dl, e, du, du2, ip, x, 1, info )
137  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
138  infot = 3
139  CALL zgttrs( 'N', 0, -1, dl, e, du, du2, ip, x, 1, info )
140  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
141  infot = 10
142  CALL zgttrs( 'N', 2, 1, dl, e, du, du2, ip, x, 1, info )
143  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
144 *
145 * ZGTRFS
146 *
147  srnamt = 'ZGTRFS'
148  infot = 1
149  CALL zgtrfs( '/', 0, 0, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
150  $ x, 1, r1, r2, w, rw, info )
151  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
152  infot = 2
153  CALL zgtrfs( 'N', -1, 0, dl, e, du, dlf, ef, duf, du2, ip, b,
154  $ 1, x, 1, r1, r2, w, rw, info )
155  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
156  infot = 3
157  CALL zgtrfs( 'N', 0, -1, dl, e, du, dlf, ef, duf, du2, ip, b,
158  $ 1, x, 1, r1, r2, w, rw, info )
159  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
160  infot = 13
161  CALL zgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
162  $ x, 2, r1, r2, w, rw, info )
163  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
164  infot = 15
165  CALL zgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 2,
166  $ x, 1, r1, r2, w, rw, info )
167  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
168 *
169 * ZGTCON
170 *
171  srnamt = 'ZGTCON'
172  infot = 1
173  CALL zgtcon( '/', 0, dl, e, du, du2, ip, anorm, rcond, w,
174  $ info )
175  CALL chkxer( 'ZGTCON', infot, nout, lerr, ok )
176  infot = 2
177  CALL zgtcon( 'I', -1, dl, e, du, du2, ip, anorm, rcond, w,
178  $ info )
179  CALL chkxer( 'ZGTCON', infot, nout, lerr, ok )
180  infot = 8
181  CALL zgtcon( 'I', 0, dl, e, du, du2, ip, -anorm, rcond, w,
182  $ info )
183  CALL chkxer( 'ZGTCON', infot, nout, lerr, ok )
184 *
185  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
186 *
187 * Test error exits for the positive definite tridiagonal
188 * routines.
189 *
190 * ZPTTRF
191 *
192  srnamt = 'ZPTTRF'
193  infot = 1
194  CALL zpttrf( -1, d, e, info )
195  CALL chkxer( 'ZPTTRF', infot, nout, lerr, ok )
196 *
197 * ZPTTRS
198 *
199  srnamt = 'ZPTTRS'
200  infot = 1
201  CALL zpttrs( '/', 1, 0, d, e, x, 1, info )
202  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
203  infot = 2
204  CALL zpttrs( 'U', -1, 0, d, e, x, 1, info )
205  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
206  infot = 3
207  CALL zpttrs( 'U', 0, -1, d, e, x, 1, info )
208  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
209  infot = 7
210  CALL zpttrs( 'U', 2, 1, d, e, x, 1, info )
211  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
212 *
213 * ZPTRFS
214 *
215  srnamt = 'ZPTRFS'
216  infot = 1
217  CALL zptrfs( '/', 1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
218  $ rw, info )
219  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
220  infot = 2
221  CALL zptrfs( 'U', -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
222  $ rw, info )
223  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
224  infot = 3
225  CALL zptrfs( 'U', 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w,
226  $ rw, info )
227  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
228  infot = 9
229  CALL zptrfs( 'U', 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w,
230  $ rw, info )
231  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
232  infot = 11
233  CALL zptrfs( 'U', 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w,
234  $ rw, info )
235  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
236 *
237 * ZPTCON
238 *
239  srnamt = 'ZPTCON'
240  infot = 1
241  CALL zptcon( -1, d, e, anorm, rcond, rw, info )
242  CALL chkxer( 'ZPTCON', infot, nout, lerr, ok )
243  infot = 4
244  CALL zptcon( 0, d, e, -anorm, rcond, rw, info )
245  CALL chkxer( 'ZPTCON', infot, nout, lerr, ok )
246  END IF
247 *
248 * Print a summary line.
249 *
250  CALL alaesm( path, ok, nout )
251 *
252  RETURN
253 *
254 * End of ZERRGT
255 *
Here is the call graph for this function:
Here is the caller graph for this function:
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
zptcon
subroutine zptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
ZPTCON
Definition: zptcon.f:121
zpttrf
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
Definition: zpttrf.f:94
zgtrfs
subroutine zgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGTRFS
Definition: zgtrfs.f:212
zgtcon
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON
Definition: zgtcon.f:143
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
zpttrs
subroutine zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
Definition: zpttrs.f:123
zgttrf
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
Definition: zgttrf.f:126
zptrfs
subroutine zptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPTRFS
Definition: zptrfs.f:185
zgttrs
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
Definition: zgttrs.f:140