OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
serrec.f
Go to the documentation of this file.
1*> \brief \b SERREC
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 SERREC( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> SERREC tests the error exits for the routines for eigen- condition
25*> estimation for REAL matrices:
26*> STRSYL, STREXC, STRSNA and STRSEN.
27*> \endverbatim
28*
29* Arguments:
30* ==========
31*
32*> \param[in] PATH
33*> \verbatim
34*> PATH is CHARACTER*3
35*> The LAPACK path name for the routines to be tested.
36*> \endverbatim
37*>
38*> \param[in] NUNIT
39*> \verbatim
40*> NUNIT is INTEGER
41*> The unit number for output.
42*> \endverbatim
43*
44* Authors:
45* ========
46*
47*> \author Univ. of Tennessee
48*> \author Univ. of California Berkeley
49*> \author Univ. of Colorado Denver
50*> \author NAG Ltd.
51*
52*> \ingroup single_eig
53*
54* =====================================================================
55 SUBROUTINE serrec( PATH, NUNIT )
56*
57* -- LAPACK test routine --
58* -- LAPACK is a software package provided by Univ. of Tennessee, --
59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60*
61* .. Scalar Arguments ..
62 CHARACTER*3 PATH
63 INTEGER NUNIT
64* ..
65*
66* =====================================================================
67*
68* .. Parameters ..
69 INTEGER NMAX
70 REAL ONE, ZERO
71 parameter( nmax = 4, one = 1.0e0, zero = 0.0e0 )
72* ..
73* .. Local Scalars ..
74 INTEGER I, IFST, ILST, INFO, J, M, NT
75 REAL SCALE
76* ..
77* .. Local Arrays ..
78 LOGICAL SEL( NMAX )
79 INTEGER IWORK( NMAX )
80 REAL A( NMAX, NMAX ), B( NMAX, NMAX ),
81 $ C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
82 $ WI( NMAX ), WORK( NMAX ), WR( NMAX )
83* ..
84* .. External Subroutines ..
85 EXTERNAL chkxer, strexc, strsen, strsna, strsyl
86* ..
87* .. Scalars in Common ..
88 LOGICAL LERR, OK
89 CHARACTER*32 SRNAMT
90 INTEGER INFOT, NOUT
91* ..
92* .. Common blocks ..
93 COMMON / infoc / infot, nout, ok, lerr
94 COMMON / srnamc / srnamt
95* ..
96* .. Executable Statements ..
97*
98 nout = nunit
99 ok = .true.
100 nt = 0
101*
102* Initialize A, B and SEL
103*
104 DO 20 j = 1, nmax
105 DO 10 i = 1, nmax
106 a( i, j ) = zero
107 b( i, j ) = zero
108 10 CONTINUE
109 20 CONTINUE
110 DO 30 i = 1, nmax
111 a( i, i ) = one
112 sel( i ) = .true.
113 30 CONTINUE
114*
115* Test STRSYL
116*
117 srnamt = 'STRSYL'
118 infot = 1
119 CALL strsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
121 infot = 2
122 CALL strsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
124 infot = 3
125 CALL strsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
127 infot = 4
128 CALL strsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
130 infot = 5
131 CALL strsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132 CALL chkxer( 'STRSYL', infot, nout, lerr, ok )
133 infot = 7
134 CALL strsyl( 'n', 'n', 1, 2, 0, A, 1, B, 1, C, 2, SCALE, INFO )
135 CALL CHKXER( 'strsyl', INFOT, NOUT, LERR, OK )
136 INFOT = 9
137 CALL STRSYL( 'n', 'n', 1, 0, 2, A, 1, B, 1, C, 1, SCALE, INFO )
138 CALL CHKXER( 'strsyl', INFOT, NOUT, LERR, OK )
139 INFOT = 11
140 CALL STRSYL( 'n', 'n', 1, 2, 0, A, 2, B, 1, C, 1, SCALE, INFO )
141 CALL CHKXER( 'strsyl', INFOT, NOUT, LERR, OK )
142 NT = NT + 8
143*
144* Test STREXC
145*
146 SRNAMT = 'strexc'
147 IFST = 1
148 ILST = 1
149 INFOT = 1
150 CALL STREXC( 'x', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
151 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
152 INFOT = 2
153 CALL STREXC( 'n', -1, A, 1, B, 1, IFST, ILST, WORK, INFO )
154 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
155 INFOT = 4
156 ILST = 2
157 CALL STREXC( 'n', 2, A, 1, B, 1, IFST, ILST, WORK, INFO )
158 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
159 INFOT = 6
160 CALL STREXC( 'v', 2, A, 2, B, 1, IFST, ILST, WORK, INFO )
161 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
162 INFOT = 7
163 IFST = 0
164 ILST = 1
165 CALL STREXC( 'v', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
166 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
167 INFOT = 7
168 IFST = 2
169 CALL STREXC( 'v', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
170 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
171 INFOT = 8
172 IFST = 1
173 ILST = 0
174 CALL STREXC( 'v', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
175 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
176 INFOT = 8
177 ILST = 2
178 CALL STREXC( 'v', 1, A, 1, B, 1, IFST, ILST, WORK, INFO )
179 CALL CHKXER( 'strexc', INFOT, NOUT, LERR, OK )
180 NT = NT + 8
181*
182* Test STRSNA
183*
184 SRNAMT = 'strsna'
185 INFOT = 1
186 CALL STRSNA( 'x', 'a', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
187 $ WORK, 1, IWORK, INFO )
188 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
189 INFOT = 2
190 CALL STRSNA( 'b', 'x', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
191 $ WORK, 1, IWORK, INFO )
192 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
193 INFOT = 4
194 CALL STRSNA( 'b', 'a', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
195 $ WORK, 1, IWORK, INFO )
196 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
197 INFOT = 6
198 CALL STRSNA( 'v', 'a', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
199 $ WORK, 2, IWORK, INFO )
200 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
201 INFOT = 8
202 CALL STRSNA( 'b', 'a', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
203 $ WORK, 2, IWORK, INFO )
204 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
205 INFOT = 10
206 CALL STRSNA( 'b', 'a', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
207 $ WORK, 2, IWORK, INFO )
208 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
209 INFOT = 13
210 CALL STRSNA( 'b', 'a', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
211 $ WORK, 1, IWORK, INFO )
212 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
213 INFOT = 13
214 CALL STRSNA( 'b', 's', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
215 $ WORK, 2, IWORK, INFO )
216 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
217 INFOT = 16
218 CALL STRSNA( 'b', 'a', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
219 $ WORK, 1, IWORK, INFO )
220 CALL CHKXER( 'strsna', INFOT, NOUT, LERR, OK )
221 NT = NT + 9
222*
223* Test STRSEN
224*
225 SEL( 1 ) = .FALSE.
226 SRNAMT = 'strsen'
227 INFOT = 1
228 CALL STRSEN( 'x', 'n', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
229 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO )
230 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
231 INFOT = 2
232 CALL STRSEN( 'n', 'x', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
233 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO )
234 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
235 INFOT = 4
236 CALL STRSEN( 'n', 'n', SEL, -1, A, 1, B, 1, WR, WI, M, S( 1 ),
237 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO )
238 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
239 INFOT = 6
240 CALL STRSEN( 'n', 'n', SEL, 2, A, 1, B, 1, WR, WI, M, S( 1 ),
241 $ SEP( 1 ), WORK, 2, IWORK, 1, INFO )
242 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
243 INFOT = 8
244 CALL STRSEN( 'n', 'v', SEL, 2, A, 2, B, 1, WR, WI, M, S( 1 ),
245 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO )
246 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
247 INFOT = 15
248 CALL STRSEN( 'n', 'v', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
249 $ SEP( 1 ), WORK, 0, IWORK, 1, INFO )
250 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
251 INFOT = 15
252 CALL STRSEN( 'e', 'v', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
253 $ SEP( 1 ), WORK, 1, IWORK, 1, INFO )
254 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
255 INFOT = 15
256 CALL STRSEN( 'v', 'v', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
257 $ SEP( 1 ), WORK, 3, IWORK, 2, INFO )
258 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
259 INFOT = 17
260 CALL STRSEN( 'e', 'v', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
261 $ SEP( 1 ), WORK, 1, IWORK, 0, INFO )
262 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
263 INFOT = 17
264 CALL STRSEN( 'v', 'v', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
265 $ SEP( 1 ), WORK, 4, IWORK, 1, INFO )
266 CALL CHKXER( 'strsen', INFOT, NOUT, LERR, OK )
267 NT = NT + 10
268*
269* Print a summary line.
270*
271 IF( OK ) THEN
272 WRITE( NOUT, FMT = 9999 )PATH, NT
273 ELSE
274 WRITE( NOUT, FMT = 9998 )PATH
275 END IF
276*
277 RETURN
278 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits(',
279 $ I3, ' tests done)' )
280 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ex',
281 $ 'its ***' )
282*
283* End of SERREC
284*
285 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
strsen
subroutine strsen(job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork, info)
STRSEN
Definition strsen.f:314
strsna
subroutine strsna(job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, iwork, info)
STRSNA
Definition strsna.f:265
strexc
subroutine strexc(compq, n, t, ldt, q, ldq, ifst, ilst, work, info)
STREXC
Definition strexc.f:148
strsyl
subroutine strsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
STRSYL
Definition strsyl.f:164
serrec
subroutine serrec(path, nunit)
SERREC
Definition serrec.f:56