LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cerrgt ( character*3  PATH,
integer  NUNIT 
)

CERRGT

Purpose: 
 CERRGT tests the error exits for the COMPLEX 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
November 2011

Definition at line 57 of file cerrgt.f.

57 *
58 * -- LAPACK test routine (version 3.4.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 * November 2011
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  REAL anorm, rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER ip( nmax )
81  REAL d( nmax ), df( nmax ), r1( nmax ), r2( nmax ),
82  $ rw( nmax )
83  COMPLEX 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, cgtcon, cgtrfs, cgttrf, cgttrs, chkxer,
93  $ cptcon, cptrfs, cpttrf, cpttrs
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.
111  e( i ) = 2.
112  dl( i ) = 3.
113  du( i ) = 4.
114  10 CONTINUE
115  anorm = 1.0
116  ok = .true.
117 *
118  IF( lsamen( 2, c2, 'GT' ) ) THEN
119 *
120 * Test error exits for the general tridiagonal routines.
121 *
122 * CGTTRF
123 *
124  srnamt = 'CGTTRF'
125  infot = 1
126  CALL cgttrf( -1, dl, e, du, du2, ip, info )
127  CALL chkxer( 'CGTTRF', infot, nout, lerr, ok )
128 *
129 * CGTTRS
130 *
131  srnamt = 'CGTTRS'
132  infot = 1
133  CALL cgttrs( '/', 0, 0, dl, e, du, du2, ip, x, 1, info )
134  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
135  infot = 2
136  CALL cgttrs( 'N', -1, 0, dl, e, du, du2, ip, x, 1, info )
137  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
138  infot = 3
139  CALL cgttrs( 'N', 0, -1, dl, e, du, du2, ip, x, 1, info )
140  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
141  infot = 10
142  CALL cgttrs( 'N', 2, 1, dl, e, du, du2, ip, x, 1, info )
143  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
144 *
145 * CGTRFS
146 *
147  srnamt = 'CGTRFS'
148  infot = 1
149  CALL cgtrfs( '/', 0, 0, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
150  $ x, 1, r1, r2, w, rw, info )
151  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
152  infot = 2
153  CALL cgtrfs( 'N', -1, 0, dl, e, du, dlf, ef, duf, du2, ip, b,
154  $ 1, x, 1, r1, r2, w, rw, info )
155  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
156  infot = 3
157  CALL cgtrfs( 'N', 0, -1, dl, e, du, dlf, ef, duf, du2, ip, b,
158  $ 1, x, 1, r1, r2, w, rw, info )
159  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
160  infot = 13
161  CALL cgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
162  $ x, 2, r1, r2, w, rw, info )
163  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
164  infot = 15
165  CALL cgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 2,
166  $ x, 1, r1, r2, w, rw, info )
167  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
168 *
169 * CGTCON
170 *
171  srnamt = 'CGTCON'
172  infot = 1
173  CALL cgtcon( '/', 0, dl, e, du, du2, ip, anorm, rcond, w,
174  $ info )
175  CALL chkxer( 'CGTCON', infot, nout, lerr, ok )
176  infot = 2
177  CALL cgtcon( 'I', -1, dl, e, du, du2, ip, anorm, rcond, w,
178  $ info )
179  CALL chkxer( 'CGTCON', infot, nout, lerr, ok )
180  infot = 8
181  CALL cgtcon( 'I', 0, dl, e, du, du2, ip, -anorm, rcond, w,
182  $ info )
183  CALL chkxer( 'CGTCON', 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 * CPTTRF
191 *
192  srnamt = 'CPTTRF'
193  infot = 1
194  CALL cpttrf( -1, d, e, info )
195  CALL chkxer( 'CPTTRF', infot, nout, lerr, ok )
196 *
197 * CPTTRS
198 *
199  srnamt = 'CPTTRS'
200  infot = 1
201  CALL cpttrs( '/', 1, 0, d, e, x, 1, info )
202  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
203  infot = 2
204  CALL cpttrs( 'U', -1, 0, d, e, x, 1, info )
205  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
206  infot = 3
207  CALL cpttrs( 'U', 0, -1, d, e, x, 1, info )
208  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
209  infot = 7
210  CALL cpttrs( 'U', 2, 1, d, e, x, 1, info )
211  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
212 *
213 * CPTRFS
214 *
215  srnamt = 'CPTRFS'
216  infot = 1
217  CALL cptrfs( '/', 1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
218  $ rw, info )
219  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
220  infot = 2
221  CALL cptrfs( 'U', -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
222  $ rw, info )
223  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
224  infot = 3
225  CALL cptrfs( 'U', 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w,
226  $ rw, info )
227  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
228  infot = 9
229  CALL cptrfs( 'U', 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w,
230  $ rw, info )
231  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
232  infot = 11
233  CALL cptrfs( 'U', 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w,
234  $ rw, info )
235  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
236 *
237 * CPTCON
238 *
239  srnamt = 'CPTCON'
240  infot = 1
241  CALL cptcon( -1, d, e, anorm, rcond, rw, info )
242  CALL chkxer( 'CPTCON', infot, nout, lerr, ok )
243  infot = 4
244  CALL cptcon( 0, d, e, -anorm, rcond, rw, info )
245  CALL chkxer( 'CPTCON', 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 CERRGT
255 *
cpttrf
subroutine cpttrf(N, D, E, INFO)
CPTTRF
Definition: cpttrf.f:94
cptcon
subroutine cptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
CPTCON
Definition: cptcon.f:121
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
cgttrf
subroutine cgttrf(N, DL, D, DU, DU2, IPIV, INFO)
CGTTRF
Definition: cgttrf.f:126
cgtcon
subroutine cgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
CGTCON
Definition: cgtcon.f:143
cpttrs
subroutine cpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
CPTTRS
Definition: cpttrs.f:123
cgttrs
subroutine cgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
CGTTRS
Definition: cgttrs.f:140
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
cptrfs
subroutine cptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPTRFS
Definition: cptrfs.f:185
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:212

Here is the call graph for this function:

Here is the caller graph for this function: