LAPACK  3.10.1
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.

Definition at line 54 of file zerrgt.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  DOUBLE PRECISION ANORM, RCOND
75 * ..
76 * .. Local Arrays ..
77  INTEGER IP( NMAX )
78  DOUBLE PRECISION D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
79  $ RW( NMAX )
80  COMPLEX*16 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, chkxer, zgtcon, zgtrfs, zgttrf, zgttrs,
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.d0
108  e( i ) = 2.d0
109  dl( i ) = 3.d0
110  du( i ) = 4.d0
111  10 CONTINUE
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 * ZGTTRF
120 *
121  srnamt = 'ZGTTRF'
122  infot = 1
123  CALL zgttrf( -1, dl, e, du, du2, ip, info )
124  CALL chkxer( 'ZGTTRF', infot, nout, lerr, ok )
125 *
126 * ZGTTRS
127 *
128  srnamt = 'ZGTTRS'
129  infot = 1
130  CALL zgttrs( '/', 0, 0, dl, e, du, du2, ip, x, 1, info )
131  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
132  infot = 2
133  CALL zgttrs( 'N', -1, 0, dl, e, du, du2, ip, x, 1, info )
134  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
135  infot = 3
136  CALL zgttrs( 'N', 0, -1, dl, e, du, du2, ip, x, 1, info )
137  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
138  infot = 10
139  CALL zgttrs( 'N', 2, 1, dl, e, du, du2, ip, x, 1, info )
140  CALL chkxer( 'ZGTTRS', infot, nout, lerr, ok )
141 *
142 * ZGTRFS
143 *
144  srnamt = 'ZGTRFS'
145  infot = 1
146  CALL zgtrfs( '/', 0, 0, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
147  $ x, 1, r1, r2, w, rw, info )
148  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
149  infot = 2
150  CALL zgtrfs( 'N', -1, 0, dl, e, du, dlf, ef, duf, du2, ip, b,
151  $ 1, x, 1, r1, r2, w, rw, info )
152  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
153  infot = 3
154  CALL zgtrfs( 'N', 0, -1, dl, e, du, dlf, ef, duf, du2, ip, b,
155  $ 1, x, 1, r1, r2, w, rw, info )
156  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
157  infot = 13
158  CALL zgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
159  $ x, 2, r1, r2, w, rw, info )
160  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
161  infot = 15
162  CALL zgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 2,
163  $ x, 1, r1, r2, w, rw, info )
164  CALL chkxer( 'ZGTRFS', infot, nout, lerr, ok )
165 *
166 * ZGTCON
167 *
168  srnamt = 'ZGTCON'
169  infot = 1
170  CALL zgtcon( '/', 0, dl, e, du, du2, ip, anorm, rcond, w,
171  $ info )
172  CALL chkxer( 'ZGTCON', infot, nout, lerr, ok )
173  infot = 2
174  CALL zgtcon( 'I', -1, dl, e, du, du2, ip, anorm, rcond, w,
175  $ info )
176  CALL chkxer( 'ZGTCON', infot, nout, lerr, ok )
177  infot = 8
178  CALL zgtcon( 'I', 0, dl, e, du, du2, ip, -anorm, rcond, w,
179  $ info )
180  CALL chkxer( 'ZGTCON', 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 * ZPTTRF
188 *
189  srnamt = 'ZPTTRF'
190  infot = 1
191  CALL zpttrf( -1, d, e, info )
192  CALL chkxer( 'ZPTTRF', infot, nout, lerr, ok )
193 *
194 * ZPTTRS
195 *
196  srnamt = 'ZPTTRS'
197  infot = 1
198  CALL zpttrs( '/', 1, 0, d, e, x, 1, info )
199  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
200  infot = 2
201  CALL zpttrs( 'U', -1, 0, d, e, x, 1, info )
202  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
203  infot = 3
204  CALL zpttrs( 'U', 0, -1, d, e, x, 1, info )
205  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
206  infot = 7
207  CALL zpttrs( 'U', 2, 1, d, e, x, 1, info )
208  CALL chkxer( 'ZPTTRS', infot, nout, lerr, ok )
209 *
210 * ZPTRFS
211 *
212  srnamt = 'ZPTRFS'
213  infot = 1
214  CALL zptrfs( '/', 1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
215  $ rw, info )
216  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
217  infot = 2
218  CALL zptrfs( 'U', -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
219  $ rw, info )
220  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
221  infot = 3
222  CALL zptrfs( 'U', 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w,
223  $ rw, info )
224  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
225  infot = 9
226  CALL zptrfs( 'U', 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w,
227  $ rw, info )
228  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
229  infot = 11
230  CALL zptrfs( 'U', 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w,
231  $ rw, info )
232  CALL chkxer( 'ZPTRFS', infot, nout, lerr, ok )
233 *
234 * ZPTCON
235 *
236  srnamt = 'ZPTCON'
237  infot = 1
238  CALL zptcon( -1, d, e, anorm, rcond, rw, info )
239  CALL chkxer( 'ZPTCON', infot, nout, lerr, ok )
240  infot = 4
241  CALL zptcon( 0, d, e, -anorm, rcond, rw, info )
242  CALL chkxer( 'ZPTCON', 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 ZERRGT
252 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
Definition: zgttrf.f:124
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON
Definition: zgtcon.f:141
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
Definition: zgttrs.f:138
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:210
subroutine zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
Definition: zpttrs.f:121
subroutine zptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPTRFS
Definition: zptrfs.f:183
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
Definition: zpttrf.f:92
subroutine zptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
ZPTCON
Definition: zptcon.f:119
Here is the call graph for this function:
Here is the caller graph for this function: