LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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,
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 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
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
subroutine spftrf(TRANSR, UPLO, N, A, INFO)
SPFTRF
Definition: spftrf.f:198
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
subroutine spftri(TRANSR, UPLO, N, A, INFO)
SPFTRI
Definition: spftri.f:191
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
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
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
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
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
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
subroutine stftri(TRANSR, UPLO, DIAG, N, A, INFO)
STFTRI
Definition: stftri.f:201
subroutine spftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
SPFTRS
Definition: spftrs.f:199
Here is the call graph for this function:
Here is the caller graph for this function: