OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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
cmplx
float cmplx[2]
Definition pblas.h:136
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
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
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
cpftrs
subroutine cpftrs(transr, uplo, n, nrhs, a, b, ldb, info)
CPFTRS
Definition cpftrs.f:220
cpftrf
subroutine cpftrf(transr, uplo, n, a, info)
CPFTRF
Definition cpftrf.f:211
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
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
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
cpftri
subroutine cpftri(transr, uplo, n, a, info)
CPFTRI
Definition cpftri.f:212
ctftri
subroutine ctftri(transr, uplo, diag, n, a, info)
CTFTRI
Definition ctftri.f:221
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
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
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
cerrrfp
subroutine cerrrfp(nunit)
CERRRFP
Definition cerrrfp.f:52