OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
serrrfp.f
Go to the documentation of this file.
1*> \brief \b SERRRFP
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 SERRRFP( NUNIT )
12*
13* .. Scalar Arguments ..
14* INTEGER NUNIT
15* ..
16*
17*
18*> \par Purpose:
19* =============
20*>
21*> \verbatim
22*>
23*> SERRRFP tests the error exits for the REAL driver routines
24*> for solving linear systems of equations.
25*>
26*> SDRVRFP tests the REAL LAPACK RFP routines:
27*> STFSM, STFTRI, SSFRK, STFTTP, STFTTR, SPFTRF, SPFTRS, STPTTF,
28*> STPTTR, STRTTF, and STRTTP
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 single_lin
49*
50* =====================================================================
51 SUBROUTINE serrrfp( 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 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*
281 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
stftri
subroutine stftri(transr, uplo, diag, n, a, info)
STFTRI
Definition stftri.f:201
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
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
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
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
spftrf
subroutine spftrf(transr, uplo, n, a, info)
SPFTRF
Definition spftrf.f:198
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
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
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
serrrfp
subroutine serrrfp(nunit)
SERRRFP
Definition serrrfp.f:52