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

◆ serrrfp()

subroutine serrrfp ( integer  nunit)

SERRRFP

Purpose:
 SERRRFP tests the error exits for the REAL driver routines
 for solving linear systems of equations.

 SDRVRFP tests the REAL LAPACK RFP routines:
     STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF,
     STPTTR, STRTTF, and STRTTP
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 serrrfp.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 REAL ALPHA, BETA
67* ..
68* .. Local Arrays ..
69 REAL A( 1, 1), B( 1, 1)
70* ..
71* .. External Subroutines ..
72 EXTERNAL chkxer, stfsm, stftri, ssfrk, stfttp, stfttr,
73 + spftri, spftrf, spftrs, stpttf, stpttr, strttf,
74 + strttp
75* ..
76* .. Scalars in Common ..
77 LOGICAL LERR, OK
78 CHARACTER*32 SRNAMT
79 INTEGER INFOT, NOUT
80* ..
81* .. Common blocks ..
82 COMMON / infoc / infot, nout, ok, lerr
83 COMMON / srnamc / srnamt
84* ..
85* .. Executable Statements ..
86*
87 nout = nunit
88 ok = .true.
89 a( 1, 1 ) = 1.0e+0
90 b( 1, 1 ) = 1.0e+0
91 alpha = 1.0e+0
92 beta = 1.0e+0
93*
94 srnamt = 'SPFTRF'
95 infot = 1
96 CALL spftrf( '/', 'U', 0, a, info )
97 CALL chkxer( 'SPFTRF', infot, nout, lerr, ok )
98 infot = 2
99 CALL spftrf( 'N', '/', 0, a, info )
100 CALL chkxer( 'SPFTRF', infot, nout, lerr, ok )
101 infot = 3
102 CALL spftrf( 'N', 'U', -1, a, info )
103 CALL chkxer( 'SPFTRF', infot, nout, lerr, ok )
104*
105 srnamt = 'SPFTRS'
106 infot = 1
107 CALL spftrs( '/', 'U', 0, 0, a, b, 1, info )
108 CALL chkxer( 'SPFTRS', infot, nout, lerr, ok )
109 infot = 2
110 CALL spftrs( 'N', '/', 0, 0, a, b, 1, info )
111 CALL chkxer( 'SPFTRS', infot, nout, lerr, ok )
112 infot = 3
113 CALL spftrs( 'N', 'U', -1, 0, a, b, 1, info )
114 CALL chkxer( 'SPFTRS', infot, nout, lerr, ok )
115 infot = 4
116 CALL spftrs( 'N', 'U', 0, -1, a, b, 1, info )
117 CALL chkxer( 'SPFTRS', infot, nout, lerr, ok )
118 infot = 7
119 CALL spftrs( 'N', 'U', 0, 0, a, b, 0, info )
120 CALL chkxer( 'SPFTRS', infot, nout, lerr, ok )
121*
122 srnamt = 'SPFTRI'
123 infot = 1
124 CALL spftri( '/', 'U', 0, a, info )
125 CALL chkxer( 'SPFTRI', infot, nout, lerr, ok )
126 infot = 2
127 CALL spftri( 'N', '/', 0, a, info )
128 CALL chkxer( 'SPFTRI', infot, nout, lerr, ok )
129 infot = 3
130 CALL spftri( 'N', 'U', -1, a, info )
131 CALL chkxer( 'SPFTRI', infot, nout, lerr, ok )
132*
133 srnamt = 'STFSM '
134 infot = 1
135 CALL stfsm( '/', 'L', 'U', 'T', 'U', 0, 0, alpha, a, b, 1 )
136 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
137 infot = 2
138 CALL stfsm( 'N', '/', 'U', 'T', 'U', 0, 0, alpha, a, b, 1 )
139 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
140 infot = 3
141 CALL stfsm( 'N', 'L', '/', 'T', 'U', 0, 0, alpha, a, b, 1 )
142 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
143 infot = 4
144 CALL stfsm( 'N', 'L', 'U', '/', 'U', 0, 0, alpha, a, b, 1 )
145 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
146 infot = 5
147 CALL stfsm( 'N', 'L', 'U', 'T', '/', 0, 0, alpha, a, b, 1 )
148 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
149 infot = 6
150 CALL stfsm( 'N', 'L', 'U', 'T', 'U', -1, 0, alpha, a, b, 1 )
151 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
152 infot = 7
153 CALL stfsm( 'N', 'L', 'U', 'T', 'U', 0, -1, alpha, a, b, 1 )
154 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
155 infot = 11
156 CALL stfsm( 'N', 'L', 'U', 'T', 'U', 0, 0, alpha, a, b, 0 )
157 CALL chkxer( 'STFSM ', infot, nout, lerr, ok )
158*
159 srnamt = 'STFTRI'
160 infot = 1
161 CALL stftri( '/', 'L', 'N', 0, a, info )
162 CALL chkxer( 'STFTRI', infot, nout, lerr, ok )
163 infot = 2
164 CALL stftri( 'N', '/', 'N', 0, a, info )
165 CALL chkxer( 'STFTRI', infot, nout, lerr, ok )
166 infot = 3
167 CALL stftri( 'N', 'L', '/', 0, a, info )
168 CALL chkxer( 'STFTRI', infot, nout, lerr, ok )
169 infot = 4
170 CALL stftri( 'N', 'L', 'N', -1, a, info )
171 CALL chkxer( 'STFTRI', infot, nout, lerr, ok )
172*
173 srnamt = 'STFTTR'
174 infot = 1
175 CALL stfttr( '/', 'U', 0, a, b, 1, info )
176 CALL chkxer( 'STFTTR', infot, nout, lerr, ok )
177 infot = 2
178 CALL stfttr( 'N', '/', 0, a, b, 1, info )
179 CALL chkxer( 'STFTTR', infot, nout, lerr, ok )
180 infot = 3
181 CALL stfttr( 'N', 'U', -1, a, b, 1, info )
182 CALL chkxer( 'STFTTR', infot, nout, lerr, ok )
183 infot = 6
184 CALL stfttr( 'N', 'U', 0, a, b, 0, info )
185 CALL chkxer( 'STFTTR', infot, nout, lerr, ok )
186*
187 srnamt = 'STRTTF'
188 infot = 1
189 CALL strttf( '/', 'U', 0, a, 1, b, info )
190 CALL chkxer( 'STRTTF', infot, nout, lerr, ok )
191 infot = 2
192 CALL strttf( 'N', '/', 0, a, 1, b, info )
193 CALL chkxer( 'STRTTF', infot, nout, lerr, ok )
194 infot = 3
195 CALL strttf( 'N', 'U', -1, a, 1, b, info )
196 CALL chkxer( 'STRTTF', infot, nout, lerr, ok )
197 infot = 5
198 CALL strttf( 'N', 'U', 0, a, 0, b, info )
199 CALL chkxer( 'STRTTF', infot, nout, lerr, ok )
200*
201 srnamt = 'STFTTP'
202 infot = 1
203 CALL stfttp( '/', 'U', 0, a, b, info )
204 CALL chkxer( 'STFTTP', infot, nout, lerr, ok )
205 infot = 2
206 CALL stfttp( 'N', '/', 0, a, b, info )
207 CALL chkxer( 'STFTTP', infot, nout, lerr, ok )
208 infot = 3
209 CALL stfttp( 'N', 'U', -1, a, b, info )
210 CALL chkxer( 'STFTTP', infot, nout, lerr, ok )
211*
212 srnamt = 'STPTTF'
213 infot = 1
214 CALL stpttf( '/', 'U', 0, a, b, info )
215 CALL chkxer( 'STPTTF', infot, nout, lerr, ok )
216 infot = 2
217 CALL stpttf( 'N', '/', 0, a, b, info )
218 CALL chkxer( 'STPTTF', infot, nout, lerr, ok )
219 infot = 3
220 CALL stpttf( 'N', 'U', -1, a, b, info )
221 CALL chkxer( 'STPTTF', infot, nout, lerr, ok )
222*
223 srnamt = 'STRTTP'
224 infot = 1
225 CALL strttp( '/', 0, a, 1, b, info )
226 CALL chkxer( 'STRTTP', infot, nout, lerr, ok )
227 infot = 2
228 CALL strttp( 'U', -1, a, 1, b, info )
229 CALL chkxer( 'STRTTP', infot, nout, lerr, ok )
230 infot = 4
231 CALL strttp( 'U', 0, a, 0, b, info )
232 CALL chkxer( 'STRTTP', infot, nout, lerr, ok )
233*
234 srnamt = 'STPTTR'
235 infot = 1
236 CALL stpttr( '/', 0, a, b, 1, info )
237 CALL chkxer( 'STPTTR', infot, nout, lerr, ok )
238 infot = 2
239 CALL stpttr( 'U', -1, a, b, 1, info )
240 CALL chkxer( 'STPTTR', infot, nout, lerr, ok )
241 infot = 5
242 CALL stpttr( 'U', 0, a, b, 0, info )
243 CALL chkxer( 'STPTTR', infot, nout, lerr, ok )
244*
245 srnamt = 'SSFRK '
246 infot = 1
247 CALL ssfrk( '/', 'U', 'N', 0, 0, alpha, a, 1, beta, b )
248 CALL chkxer( 'SSFRK ', infot, nout, lerr, ok )
249 infot = 2
250 CALL ssfrk( 'N', '/', 'N', 0, 0, alpha, a, 1, beta, b )
251 CALL chkxer( 'SSFRK ', infot, nout, lerr, ok )
252 infot = 3
253 CALL ssfrk( 'N', 'U', '/', 0, 0, alpha, a, 1, beta, b )
254 CALL chkxer( 'SSFRK ', infot, nout, lerr, ok )
255 infot = 4
256 CALL ssfrk( 'N', 'U', 'N', -1, 0, alpha, a, 1, beta, b )
257 CALL chkxer( 'SSFRK ', infot, nout, lerr, ok )
258 infot = 5
259 CALL ssfrk( 'N', 'U', 'N', 0, -1, alpha, a, 1, beta, b )
260 CALL chkxer( 'SSFRK ', infot, nout, lerr, ok )
261 infot = 8
262 CALL ssfrk( 'N', 'U', 'N', 0, 0, alpha, a, 0, beta, b )
263 CALL chkxer( 'SSFRK ', infot, nout, lerr, ok )
264*
265* Print a summary line.
266*
267 IF( ok ) THEN
268 WRITE( nout, fmt = 9999 )
269 ELSE
270 WRITE( nout, fmt = 9998 )
271 END IF
272*
273 9999 FORMAT( 1x, 'REAL RFP routines passed the tests of ',
274 $ 'the error exits' )
275 9998 FORMAT( ' *** RFP routines failed the tests of the error ',
276 $ 'exits ***' )
277 RETURN
278*
279* End of SERRRFP
280*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
ssfrk
subroutine ssfrk(transr, uplo, trans, n, k, alpha, a, lda, beta, c)
SSFRK performs a symmetric rank-k operation for matrix in RFP format.
Definition ssfrk.f:166
spftrf
subroutine spftrf(transr, uplo, n, a, info)
SPFTRF
Definition spftrf.f:198
spftri
subroutine spftri(transr, uplo, n, a, info)
SPFTRI
Definition spftri.f:191
spftrs
subroutine spftrs(transr, uplo, n, nrhs, a, b, ldb, info)
SPFTRS
Definition spftrs.f:199
stfsm
subroutine stfsm(transr, side, uplo, trans, diag, m, n, alpha, a, b, ldb)
STFSM solves a matrix equation (one operand is a triangular matrix in RFP format).
Definition stfsm.f:277
stftri
subroutine stftri(transr, uplo, diag, n, a, info)
STFTRI
Definition stftri.f:201
stfttp
subroutine stfttp(transr, uplo, n, arf, ap, info)
STFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
Definition stfttp.f:187
stfttr
subroutine stfttr(transr, uplo, n, arf, a, lda, info)
STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition stfttr.f:196
stpttf
subroutine stpttf(transr, uplo, n, ap, arf, info)
STPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
Definition stpttf.f:186
stpttr
subroutine stpttr(uplo, n, ap, a, lda, info)
STPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
Definition stpttr.f:104
strttf
subroutine strttf(transr, uplo, n, a, lda, arf, info)
STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition strttf.f:194
strttp
subroutine strttp(uplo, n, a, lda, ap, info)
STRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...
Definition strttp.f:104
Here is the call graph for this function:
Here is the caller graph for this function: