LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
cerrgt.f
Go to the documentation of this file.
1 *> \brief \b CERRGT
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 CERRGT( 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 *> CERRGT tests the error exits for the COMPLEX 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 complex_lin
52 *
53 * =====================================================================
54  SUBROUTINE cerrgt( 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 I, INFO
74  REAL ANORM, RCOND
75 * ..
76 * .. Local Arrays ..
77  INTEGER IP( NMAX )
78  REAL D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
79  $ RW( NMAX )
80  COMPLEX 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, cgtcon, cgtrfs, cgttrf, cgttrs, chkxer,
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.
108  e( i ) = 2.
109  dl( i ) = 3.
110  du( i ) = 4.
111  10 CONTINUE
112  anorm = 1.0
113  ok = .true.
114 *
115  IF( lsamen( 2, c2, 'GT' ) ) THEN
116 *
117 * Test error exits for the general tridiagonal routines.
118 *
119 * CGTTRF
120 *
121  srnamt = 'CGTTRF'
122  infot = 1
123  CALL cgttrf( -1, dl, e, du, du2, ip, info )
124  CALL chkxer( 'CGTTRF', infot, nout, lerr, ok )
125 *
126 * CGTTRS
127 *
128  srnamt = 'CGTTRS'
129  infot = 1
130  CALL cgttrs( '/', 0, 0, dl, e, du, du2, ip, x, 1, info )
131  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
132  infot = 2
133  CALL cgttrs( 'N', -1, 0, dl, e, du, du2, ip, x, 1, info )
134  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
135  infot = 3
136  CALL cgttrs( 'N', 0, -1, dl, e, du, du2, ip, x, 1, info )
137  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
138  infot = 10
139  CALL cgttrs( 'N', 2, 1, dl, e, du, du2, ip, x, 1, info )
140  CALL chkxer( 'CGTTRS', infot, nout, lerr, ok )
141 *
142 * CGTRFS
143 *
144  srnamt = 'CGTRFS'
145  infot = 1
146  CALL cgtrfs( '/', 0, 0, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
147  $ x, 1, r1, r2, w, rw, info )
148  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
149  infot = 2
150  CALL cgtrfs( 'N', -1, 0, dl, e, du, dlf, ef, duf, du2, ip, b,
151  $ 1, x, 1, r1, r2, w, rw, info )
152  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
153  infot = 3
154  CALL cgtrfs( 'N', 0, -1, dl, e, du, dlf, ef, duf, du2, ip, b,
155  $ 1, x, 1, r1, r2, w, rw, info )
156  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
157  infot = 13
158  CALL cgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 1,
159  $ x, 2, r1, r2, w, rw, info )
160  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
161  infot = 15
162  CALL cgtrfs( 'N', 2, 1, dl, e, du, dlf, ef, duf, du2, ip, b, 2,
163  $ x, 1, r1, r2, w, rw, info )
164  CALL chkxer( 'CGTRFS', infot, nout, lerr, ok )
165 *
166 * CGTCON
167 *
168  srnamt = 'CGTCON'
169  infot = 1
170  CALL cgtcon( '/', 0, dl, e, du, du2, ip, anorm, rcond, w,
171  $ info )
172  CALL chkxer( 'CGTCON', infot, nout, lerr, ok )
173  infot = 2
174  CALL cgtcon( 'I', -1, dl, e, du, du2, ip, anorm, rcond, w,
175  $ info )
176  CALL chkxer( 'CGTCON', infot, nout, lerr, ok )
177  infot = 8
178  CALL cgtcon( 'I', 0, dl, e, du, du2, ip, -anorm, rcond, w,
179  $ info )
180  CALL chkxer( 'CGTCON', 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 * CPTTRF
188 *
189  srnamt = 'CPTTRF'
190  infot = 1
191  CALL cpttrf( -1, d, e, info )
192  CALL chkxer( 'CPTTRF', infot, nout, lerr, ok )
193 *
194 * CPTTRS
195 *
196  srnamt = 'CPTTRS'
197  infot = 1
198  CALL cpttrs( '/', 1, 0, d, e, x, 1, info )
199  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
200  infot = 2
201  CALL cpttrs( 'U', -1, 0, d, e, x, 1, info )
202  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
203  infot = 3
204  CALL cpttrs( 'U', 0, -1, d, e, x, 1, info )
205  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
206  infot = 7
207  CALL cpttrs( 'U', 2, 1, d, e, x, 1, info )
208  CALL chkxer( 'CPTTRS', infot, nout, lerr, ok )
209 *
210 * CPTRFS
211 *
212  srnamt = 'CPTRFS'
213  infot = 1
214  CALL cptrfs( '/', 1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
215  $ rw, info )
216  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
217  infot = 2
218  CALL cptrfs( 'U', -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w,
219  $ rw, info )
220  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
221  infot = 3
222  CALL cptrfs( 'U', 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w,
223  $ rw, info )
224  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
225  infot = 9
226  CALL cptrfs( 'U', 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w,
227  $ rw, info )
228  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
229  infot = 11
230  CALL cptrfs( 'U', 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w,
231  $ rw, info )
232  CALL chkxer( 'CPTRFS', infot, nout, lerr, ok )
233 *
234 * CPTCON
235 *
236  srnamt = 'CPTCON'
237  infot = 1
238  CALL cptcon( -1, d, e, anorm, rcond, rw, info )
239  CALL chkxer( 'CPTCON', infot, nout, lerr, ok )
240  infot = 4
241  CALL cptcon( 0, d, e, -anorm, rcond, rw, info )
242  CALL chkxer( 'CPTCON', 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 CERRGT
252 *
253  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cerrgt(PATH, NUNIT)
CERRGT
Definition: cerrgt.f:55
subroutine cgttrf(N, DL, D, DU, DU2, IPIV, INFO)
CGTTRF
Definition: cgttrf.f:124
subroutine cgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
CGTCON
Definition: cgtcon.f:141
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:210
subroutine cgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
CGTTRS
Definition: cgttrs.f:138
subroutine cptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPTRFS
Definition: cptrfs.f:183
subroutine cptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
CPTCON
Definition: cptcon.f:119
subroutine cpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
CPTTRS
Definition: cpttrs.f:121
subroutine cpttrf(N, D, E, INFO)
CPTTRF
Definition: cpttrf.f:92