LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
cerrrfp.f
Go to the documentation of this file.
1 *> \brief \b CERRRFP
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 CERRRFP( NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> CERRRFP tests the error exits for the COMPLEX driver routines
24 *> for solving linear systems of equations.
25 *>
26 *> CDRVRFP tests the COMPLEX LAPACK RFP routines:
27 *> CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, CPFTRF, CPFTRS, CTPTTF,
28 *> CTPTTR, CTRTTF, and CTRTTP
29 *> \endverbatim
30 *
31 * Arguments:
32 * ==========
33 *
34 *> \param[in] NUNIT
35 *> \verbatim
36 *> NUNIT is INTEGER
37 *> The unit number for output.
38 *> \endverbatim
39 *
40 * Authors:
41 * ========
42 *
43 *> \author Univ. of Tennessee
44 *> \author Univ. of California Berkeley
45 *> \author Univ. of Colorado Denver
46 *> \author NAG Ltd.
47 *
48 *> \ingroup complex_lin
49 *
50 * =====================================================================
51  SUBROUTINE cerrrfp( NUNIT )
52 *
53 * -- LAPACK test routine --
54 * -- LAPACK is a software package provided by Univ. of Tennessee, --
55 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
56 *
57 * .. Scalar Arguments ..
58  INTEGER NUNIT
59 * ..
60 *
61 * =====================================================================
62 *
63 * ..
64 * .. Local Scalars ..
65  INTEGER INFO
66  COMPLEX ALPHA, BETA
67 * ..
68 * .. Local Arrays ..
69  COMPLEX A( 1, 1), B( 1, 1)
70 * ..
71 * .. External Subroutines ..
72  EXTERNAL chkxer, ctfsm, ctftri, chfrk, ctfttp, ctfttr,
73  + cpftri, cpftrf, cpftrs, ctpttf, ctpttr, ctrttf,
74  + ctrttp
75 * ..
76 * .. Scalars in Common ..
77  LOGICAL LERR, OK
78  CHARACTER*32 SRNAMT
79  INTEGER INFOT, NOUT
80 * ..
81 * .. Intrinsic Functions ..
82  INTRINSIC cmplx
83 * ..
84 * .. Common blocks ..
85  COMMON / infoc / infot, nout, ok, lerr
86  COMMON / srnamc / srnamt
87 * ..
88 * .. Executable Statements ..
89 *
90  nout = nunit
91  ok = .true.
92  a( 1, 1 ) = cmplx( 1.d0 , 1.d0 )
93  b( 1, 1 ) = cmplx( 1.d0 , 1.d0 )
94  alpha = cmplx( 1.d0 , 1.d0 )
95  beta = cmplx( 1.d0 , 1.d0 )
96 *
97  srnamt = 'CPFTRF'
98  infot = 1
99  CALL cpftrf( '/', 'U', 0, a, info )
100  CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
101  infot = 2
102  CALL cpftrf( 'N', '/', 0, a, info )
103  CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
104  infot = 3
105  CALL cpftrf( 'N', 'U', -1, a, info )
106  CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
107 *
108  srnamt = 'CPFTRS'
109  infot = 1
110  CALL cpftrs( '/', 'U', 0, 0, a, b, 1, info )
111  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
112  infot = 2
113  CALL cpftrs( 'N', '/', 0, 0, a, b, 1, info )
114  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
115  infot = 3
116  CALL cpftrs( 'N', 'U', -1, 0, a, b, 1, info )
117  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
118  infot = 4
119  CALL cpftrs( 'N', 'U', 0, -1, a, b, 1, info )
120  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
121  infot = 7
122  CALL cpftrs( 'N', 'U', 0, 0, a, b, 0, info )
123  CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
124 *
125  srnamt = 'CPFTRI'
126  infot = 1
127  CALL cpftri( '/', 'U', 0, a, info )
128  CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
129  infot = 2
130  CALL cpftri( 'N', '/', 0, a, info )
131  CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
132  infot = 3
133  CALL cpftri( 'N', 'U', -1, a, info )
134  CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
135 *
136  srnamt = 'CTFSM '
137  infot = 1
138  CALL ctfsm( '/', 'L', 'U', 'C', 'U', 0, 0, alpha, a, b, 1 )
139  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
140  infot = 2
141  CALL ctfsm( 'N', '/', 'U', 'C', 'U', 0, 0, alpha, a, b, 1 )
142  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
143  infot = 3
144  CALL ctfsm( 'N', 'L', '/', 'C', 'U', 0, 0, alpha, a, b, 1 )
145  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
146  infot = 4
147  CALL ctfsm( 'N', 'L', 'U', '/', 'U', 0, 0, alpha, a, b, 1 )
148  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
149  infot = 5
150  CALL ctfsm( 'N', 'L', 'U', 'C', '/', 0, 0, alpha, a, b, 1 )
151  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
152  infot = 6
153  CALL ctfsm( 'N', 'L', 'U', 'C', 'U', -1, 0, alpha, a, b, 1 )
154  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
155  infot = 7
156  CALL ctfsm( 'N', 'L', 'U', 'C', 'U', 0, -1, alpha, a, b, 1 )
157  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
158  infot = 11
159  CALL ctfsm( 'N', 'L', 'U', 'C', 'U', 0, 0, alpha, a, b, 0 )
160  CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
161 *
162  srnamt = 'CTFTRI'
163  infot = 1
164  CALL ctftri( '/', 'L', 'N', 0, a, info )
165  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
166  infot = 2
167  CALL ctftri( 'N', '/', 'N', 0, a, info )
168  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
169  infot = 3
170  CALL ctftri( 'N', 'L', '/', 0, a, info )
171  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
172  infot = 4
173  CALL ctftri( 'N', 'L', 'N', -1, a, info )
174  CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
175 *
176  srnamt = 'CTFTTR'
177  infot = 1
178  CALL ctfttr( '/', 'U', 0, a, b, 1, info )
179  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
180  infot = 2
181  CALL ctfttr( 'N', '/', 0, a, b, 1, info )
182  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
183  infot = 3
184  CALL ctfttr( 'N', 'U', -1, a, b, 1, info )
185  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
186  infot = 6
187  CALL ctfttr( 'N', 'U', 0, a, b, 0, info )
188  CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
189 *
190  srnamt = 'CTRTTF'
191  infot = 1
192  CALL ctrttf( '/', 'U', 0, a, 1, b, info )
193  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
194  infot = 2
195  CALL ctrttf( 'N', '/', 0, a, 1, b, info )
196  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
197  infot = 3
198  CALL ctrttf( 'N', 'U', -1, a, 1, b, info )
199  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
200  infot = 5
201  CALL ctrttf( 'N', 'U', 0, a, 0, b, info )
202  CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
203 *
204  srnamt = 'CTFTTP'
205  infot = 1
206  CALL ctfttp( '/', 'U', 0, a, b, info )
207  CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
208  infot = 2
209  CALL ctfttp( 'N', '/', 0, a, b, info )
210  CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
211  infot = 3
212  CALL ctfttp( 'N', 'U', -1, a, b, info )
213  CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
214 *
215  srnamt = 'CTPTTF'
216  infot = 1
217  CALL ctpttf( '/', 'U', 0, a, b, info )
218  CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
219  infot = 2
220  CALL ctpttf( 'N', '/', 0, a, b, info )
221  CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
222  infot = 3
223  CALL ctpttf( 'N', 'U', -1, a, b, info )
224  CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
225 *
226  srnamt = 'CTRTTP'
227  infot = 1
228  CALL ctrttp( '/', 0, a, 1, b, info )
229  CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
230  infot = 2
231  CALL ctrttp( 'U', -1, a, 1, b, info )
232  CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
233  infot = 4
234  CALL ctrttp( 'U', 0, a, 0, b, info )
235  CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
236 *
237  srnamt = 'CTPTTR'
238  infot = 1
239  CALL ctpttr( '/', 0, a, b, 1, info )
240  CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
241  infot = 2
242  CALL ctpttr( 'U', -1, a, b, 1, info )
243  CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
244  infot = 5
245  CALL ctpttr( 'U', 0, a, b, 0, info )
246  CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
247 *
248  srnamt = 'CHFRK '
249  infot = 1
250  CALL chfrk( '/', 'U', 'N', 0, 0, alpha, a, 1, beta, b )
251  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
252  infot = 2
253  CALL chfrk( 'N', '/', 'N', 0, 0, alpha, a, 1, beta, b )
254  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
255  infot = 3
256  CALL chfrk( 'N', 'U', '/', 0, 0, alpha, a, 1, beta, b )
257  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
258  infot = 4
259  CALL chfrk( 'N', 'U', 'N', -1, 0, alpha, a, 1, beta, b )
260  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
261  infot = 5
262  CALL chfrk( 'N', 'U', 'N', 0, -1, alpha, a, 1, beta, b )
263  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
264  infot = 8
265  CALL chfrk( 'N', 'U', 'N', 0, 0, alpha, a, 0, beta, b )
266  CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
267 *
268 * Print a summary line.
269 *
270  IF( ok ) THEN
271  WRITE( nout, fmt = 9999 )
272  ELSE
273  WRITE( nout, fmt = 9998 )
274  END IF
275 *
276  9999 FORMAT( 1x, 'COMPLEX RFP routines passed the tests of the ',
277  $ 'error exits' )
278  9998 FORMAT( ' *** RFP routines failed the tests of the error ',
279  $ 'exits ***' )
280  RETURN
281 *
282 * End of CERRRFP
283 *
284  END
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
cerrrfp
subroutine cerrrfp(NUNIT)
CERRRFP
Definition: cerrrfp.f:52
ctfsm
subroutine ctfsm(TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, B, LDB)
CTFSM solves a matrix equation (one operand is a triangular matrix in RFP format).
Definition: ctfsm.f:298
ctfttr
subroutine ctfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition: ctfttr.f:216
ctftri
subroutine ctftri(TRANSR, UPLO, DIAG, N, A, INFO)
CTFTRI
Definition: ctftri.f:221
chfrk
subroutine chfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
CHFRK performs a Hermitian rank-k operation for matrix in RFP format.
Definition: chfrk.f:168
cpftrs
subroutine cpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
CPFTRS
Definition: cpftrs.f:220
cpftri
subroutine cpftri(TRANSR, UPLO, N, A, INFO)
CPFTRI
Definition: cpftri.f:212
ctpttr
subroutine ctpttr(UPLO, N, AP, A, LDA, INFO)
CTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
Definition: ctpttr.f:104
ctrttp
subroutine ctrttp(UPLO, N, A, LDA, AP, INFO)
CTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...
Definition: ctrttp.f:104
cpftrf
subroutine cpftrf(TRANSR, UPLO, N, A, INFO)
CPFTRF
Definition: cpftrf.f:211
ctpttf
subroutine ctpttf(TRANSR, UPLO, N, AP, ARF, INFO)
CTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
Definition: ctpttf.f:207
ctfttp
subroutine ctfttp(TRANSR, UPLO, N, ARF, AP, INFO)
CTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
Definition: ctfttp.f:208
ctrttf
subroutine ctrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: ctrttf.f:216