LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cerrgt()

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.

Definition at line 54 of file cerrgt.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  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 *
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 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
Here is the call graph for this function:
Here is the caller graph for this function: