LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cerrrfp()

subroutine cerrrfp ( integer  nunit)

CERRRFP

Purpose:
 CERRRFP tests the error exits for the COMPLEX driver routines
 for solving linear systems of equations.

 CDRVRFP tests the COMPLEX LAPACK RFP routines:
     CTFSM, CTFTRI, CHFRK, CTFTTP, CTFTTR, CPFTRF, CPFTRS, CTPTTF,
     CTPTTR, CTRTTF, and CTRTTP
Parameters
[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 51 of file cerrrfp.f.

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 ALPHACMPLX
67 REAL ALPHA, BETA
68* ..
69* .. Local Arrays ..
70 COMPLEX A( 1, 1), B( 1, 1)
71* ..
72* .. External Subroutines ..
73 EXTERNAL chkxer, ctfsm, ctftri, chfrk, ctfttp, ctfttr,
74 + cpftri, cpftrf, cpftrs, ctpttf, ctpttr, ctrttf,
75 + ctrttp
76* ..
77* .. Scalars in Common ..
78 LOGICAL LERR, OK
79 CHARACTER*32 SRNAMT
80 INTEGER INFOT, NOUT
81* ..
82* .. Intrinsic Functions ..
83 INTRINSIC cmplx
84* ..
85* .. Common blocks ..
86 COMMON / infoc / infot, nout, ok, lerr
87 COMMON / srnamc / srnamt
88* ..
89* .. Executable Statements ..
90*
91 nout = nunit
92 ok = .true.
93 a( 1, 1 ) = cmplx( 1.0 , 1.0 )
94 b( 1, 1 ) = cmplx( 1.0 , 1.0 )
95 alphacmplx = cmplx( 1.0 , 1.0 )
96 alpha = 1.0
97 beta = 1.0
98*
99 srnamt = 'CPFTRF'
100 infot = 1
101 CALL cpftrf( '/', 'U', 0, a, info )
102 CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
103 infot = 2
104 CALL cpftrf( 'N', '/', 0, a, info )
105 CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
106 infot = 3
107 CALL cpftrf( 'N', 'U', -1, a, info )
108 CALL chkxer( 'CPFTRF', infot, nout, lerr, ok )
109*
110 srnamt = 'CPFTRS'
111 infot = 1
112 CALL cpftrs( '/', 'U', 0, 0, a, b, 1, info )
113 CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
114 infot = 2
115 CALL cpftrs( 'N', '/', 0, 0, a, b, 1, info )
116 CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
117 infot = 3
118 CALL cpftrs( 'N', 'U', -1, 0, a, b, 1, info )
119 CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
120 infot = 4
121 CALL cpftrs( 'N', 'U', 0, -1, a, b, 1, info )
122 CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
123 infot = 7
124 CALL cpftrs( 'N', 'U', 0, 0, a, b, 0, info )
125 CALL chkxer( 'CPFTRS', infot, nout, lerr, ok )
126*
127 srnamt = 'CPFTRI'
128 infot = 1
129 CALL cpftri( '/', 'U', 0, a, info )
130 CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
131 infot = 2
132 CALL cpftri( 'N', '/', 0, a, info )
133 CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
134 infot = 3
135 CALL cpftri( 'N', 'U', -1, a, info )
136 CALL chkxer( 'CPFTRI', infot, nout, lerr, ok )
137*
138 srnamt = 'CTFSM '
139 infot = 1
140 CALL ctfsm( '/', 'L', 'U', 'C', 'U', 0, 0, alphacmplx, a, b, 1 )
141 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
142 infot = 2
143 CALL ctfsm( 'N', '/', 'U', 'C', 'U', 0, 0, alphacmplx, a, b, 1 )
144 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
145 infot = 3
146 CALL ctfsm( 'N', 'L', '/', 'C', 'U', 0, 0, alphacmplx, a, b, 1 )
147 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
148 infot = 4
149 CALL ctfsm( 'N', 'L', 'U', '/', 'U', 0, 0, alphacmplx, a, b, 1 )
150 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
151 infot = 5
152 CALL ctfsm( 'N', 'L', 'U', 'C', '/', 0, 0, alphacmplx, a, b, 1 )
153 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
154 infot = 6
155 CALL ctfsm( 'N', 'L', 'U', 'C', 'U', -1, 0, alphacmplx, a, b, 1 )
156 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
157 infot = 7
158 CALL ctfsm( 'N', 'L', 'U', 'C', 'U', 0, -1, alphacmplx, a, b, 1 )
159 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
160 infot = 11
161 CALL ctfsm( 'N', 'L', 'U', 'C', 'U', 0, 0, alphacmplx, a, b, 0 )
162 CALL chkxer( 'CTFSM ', infot, nout, lerr, ok )
163*
164 srnamt = 'CTFTRI'
165 infot = 1
166 CALL ctftri( '/', 'L', 'N', 0, a, info )
167 CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
168 infot = 2
169 CALL ctftri( 'N', '/', 'N', 0, a, info )
170 CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
171 infot = 3
172 CALL ctftri( 'N', 'L', '/', 0, a, info )
173 CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
174 infot = 4
175 CALL ctftri( 'N', 'L', 'N', -1, a, info )
176 CALL chkxer( 'CTFTRI', infot, nout, lerr, ok )
177*
178 srnamt = 'CTFTTR'
179 infot = 1
180 CALL ctfttr( '/', 'U', 0, a, b, 1, info )
181 CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
182 infot = 2
183 CALL ctfttr( 'N', '/', 0, a, b, 1, info )
184 CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
185 infot = 3
186 CALL ctfttr( 'N', 'U', -1, a, b, 1, info )
187 CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
188 infot = 6
189 CALL ctfttr( 'N', 'U', 0, a, b, 0, info )
190 CALL chkxer( 'CTFTTR', infot, nout, lerr, ok )
191*
192 srnamt = 'CTRTTF'
193 infot = 1
194 CALL ctrttf( '/', 'U', 0, a, 1, b, info )
195 CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
196 infot = 2
197 CALL ctrttf( 'N', '/', 0, a, 1, b, info )
198 CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
199 infot = 3
200 CALL ctrttf( 'N', 'U', -1, a, 1, b, info )
201 CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
202 infot = 5
203 CALL ctrttf( 'N', 'U', 0, a, 0, b, info )
204 CALL chkxer( 'CTRTTF', infot, nout, lerr, ok )
205*
206 srnamt = 'CTFTTP'
207 infot = 1
208 CALL ctfttp( '/', 'U', 0, a, b, info )
209 CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
210 infot = 2
211 CALL ctfttp( 'N', '/', 0, a, b, info )
212 CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
213 infot = 3
214 CALL ctfttp( 'N', 'U', -1, a, b, info )
215 CALL chkxer( 'CTFTTP', infot, nout, lerr, ok )
216*
217 srnamt = 'CTPTTF'
218 infot = 1
219 CALL ctpttf( '/', 'U', 0, a, b, info )
220 CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
221 infot = 2
222 CALL ctpttf( 'N', '/', 0, a, b, info )
223 CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
224 infot = 3
225 CALL ctpttf( 'N', 'U', -1, a, b, info )
226 CALL chkxer( 'CTPTTF', infot, nout, lerr, ok )
227*
228 srnamt = 'CTRTTP'
229 infot = 1
230 CALL ctrttp( '/', 0, a, 1, b, info )
231 CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
232 infot = 2
233 CALL ctrttp( 'U', -1, a, 1, b, info )
234 CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
235 infot = 4
236 CALL ctrttp( 'U', 0, a, 0, b, info )
237 CALL chkxer( 'CTRTTP', infot, nout, lerr, ok )
238*
239 srnamt = 'CTPTTR'
240 infot = 1
241 CALL ctpttr( '/', 0, a, b, 1, info )
242 CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
243 infot = 2
244 CALL ctpttr( 'U', -1, a, b, 1, info )
245 CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
246 infot = 5
247 CALL ctpttr( 'U', 0, a, b, 0, info )
248 CALL chkxer( 'CTPTTR', infot, nout, lerr, ok )
249*
250 srnamt = 'CHFRK '
251 infot = 1
252 CALL chfrk( '/', 'U', 'N', 0, 0, alpha, a, 1, beta, b )
253 CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
254 infot = 2
255 CALL chfrk( 'N', '/', 'N', 0, 0, alpha, a, 1, beta, b )
256 CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
257 infot = 3
258 CALL chfrk( 'N', 'U', '/', 0, 0, alpha, a, 1, beta, b )
259 CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
260 infot = 4
261 CALL chfrk( 'N', 'U', 'N', -1, 0, alpha, a, 1, beta, b )
262 CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
263 infot = 5
264 CALL chfrk( 'N', 'U', 'N', 0, -1, alpha, a, 1, beta, b )
265 CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
266 infot = 8
267 CALL chfrk( 'N', 'U', 'N', 0, 0, alpha, a, 0, beta, b )
268 CALL chkxer( 'CHFRK ', infot, nout, lerr, ok )
269*
270* Print a summary line.
271*
272 IF( ok ) THEN
273 WRITE( nout, fmt = 9999 )
274 ELSE
275 WRITE( nout, fmt = 9998 )
276 END IF
277*
278 9999 FORMAT( 1x, 'COMPLEX RFP routines passed the tests of the ',
279 $ 'error exits' )
280 9998 FORMAT( ' *** RFP routines failed the tests of the error ',
281 $ 'exits ***' )
282 RETURN
283*
284* End of CERRRFP
285*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
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
cpftrf
subroutine cpftrf(transr, uplo, n, a, info)
CPFTRF
Definition cpftrf.f:211
cpftri
subroutine cpftri(transr, uplo, n, a, info)
CPFTRI
Definition cpftri.f:212
cpftrs
subroutine cpftrs(transr, uplo, n, nrhs, a, b, ldb, info)
CPFTRS
Definition cpftrs.f:220
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
ctftri
subroutine ctftri(transr, uplo, diag, n, a, info)
CTFTRI
Definition ctftri.f:221
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
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
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
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
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
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
Here is the call graph for this function:
Here is the caller graph for this function: