LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
derrrfp.f
Go to the documentation of this file.
1 *> \brief \b DERRRFP
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 DERRRFP( NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER NUNIT
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> DERRRFP tests the error exits for the DOUBLE PRECISION driver routines
24 *> for solving linear systems of equations.
25 *>
26 *> DDRVRFP tests the DOUBLE PRECISION LAPACK RFP routines:
27 *> DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, DPFTRF, DPFTRS, DTPTTF,
28 *> DTPTTR, DTRTTF, and DTRTTP
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 double_lin
49 *
50 * =====================================================================
51  SUBROUTINE derrrfp( 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  DOUBLE PRECISION ALPHA, BETA
67 * ..
68 * .. Local Arrays ..
69  DOUBLE PRECISION A( 1, 1), B( 1, 1)
70 * ..
71 * .. External Subroutines ..
72  EXTERNAL chkxer, dtfsm, dtftri, dsfrk, dtfttp, dtfttr,
74  + dtrttp
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.0d+0
90  b( 1, 1 ) = 1.0d+0
91  alpha = 1.0d+0
92  beta = 1.0d+0
93 *
94  srnamt = 'DPFTRF'
95  infot = 1
96  CALL dpftrf( '/', 'U', 0, a, info )
97  CALL chkxer( 'DPFTRF', infot, nout, lerr, ok )
98  infot = 2
99  CALL dpftrf( 'N', '/', 0, a, info )
100  CALL chkxer( 'DPFTRF', infot, nout, lerr, ok )
101  infot = 3
102  CALL dpftrf( 'N', 'U', -1, a, info )
103  CALL chkxer( 'DPFTRF', infot, nout, lerr, ok )
104 *
105  srnamt = 'DPFTRS'
106  infot = 1
107  CALL dpftrs( '/', 'U', 0, 0, a, b, 1, info )
108  CALL chkxer( 'DPFTRS', infot, nout, lerr, ok )
109  infot = 2
110  CALL dpftrs( 'N', '/', 0, 0, a, b, 1, info )
111  CALL chkxer( 'DPFTRS', infot, nout, lerr, ok )
112  infot = 3
113  CALL dpftrs( 'N', 'U', -1, 0, a, b, 1, info )
114  CALL chkxer( 'DPFTRS', infot, nout, lerr, ok )
115  infot = 4
116  CALL dpftrs( 'N', 'U', 0, -1, a, b, 1, info )
117  CALL chkxer( 'DPFTRS', infot, nout, lerr, ok )
118  infot = 7
119  CALL dpftrs( 'N', 'U', 0, 0, a, b, 0, info )
120  CALL chkxer( 'DPFTRS', infot, nout, lerr, ok )
121 *
122  srnamt = 'DPFTRI'
123  infot = 1
124  CALL dpftri( '/', 'U', 0, a, info )
125  CALL chkxer( 'DPFTRI', infot, nout, lerr, ok )
126  infot = 2
127  CALL dpftri( 'N', '/', 0, a, info )
128  CALL chkxer( 'DPFTRI', infot, nout, lerr, ok )
129  infot = 3
130  CALL dpftri( 'N', 'U', -1, a, info )
131  CALL chkxer( 'DPFTRI', infot, nout, lerr, ok )
132 *
133  srnamt = 'DTFSM '
134  infot = 1
135  CALL dtfsm( '/', 'L', 'U', 'T', 'U', 0, 0, alpha, a, b, 1 )
136  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
137  infot = 2
138  CALL dtfsm( 'N', '/', 'U', 'T', 'U', 0, 0, alpha, a, b, 1 )
139  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
140  infot = 3
141  CALL dtfsm( 'N', 'L', '/', 'T', 'U', 0, 0, alpha, a, b, 1 )
142  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
143  infot = 4
144  CALL dtfsm( 'N', 'L', 'U', '/', 'U', 0, 0, alpha, a, b, 1 )
145  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
146  infot = 5
147  CALL dtfsm( 'N', 'L', 'U', 'T', '/', 0, 0, alpha, a, b, 1 )
148  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
149  infot = 6
150  CALL dtfsm( 'N', 'L', 'U', 'T', 'U', -1, 0, alpha, a, b, 1 )
151  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
152  infot = 7
153  CALL dtfsm( 'N', 'L', 'U', 'T', 'U', 0, -1, alpha, a, b, 1 )
154  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
155  infot = 11
156  CALL dtfsm( 'N', 'L', 'U', 'T', 'U', 0, 0, alpha, a, b, 0 )
157  CALL chkxer( 'DTFSM ', infot, nout, lerr, ok )
158 *
159  srnamt = 'DTFTRI'
160  infot = 1
161  CALL dtftri( '/', 'L', 'N', 0, a, info )
162  CALL chkxer( 'DTFTRI', infot, nout, lerr, ok )
163  infot = 2
164  CALL dtftri( 'N', '/', 'N', 0, a, info )
165  CALL chkxer( 'DTFTRI', infot, nout, lerr, ok )
166  infot = 3
167  CALL dtftri( 'N', 'L', '/', 0, a, info )
168  CALL chkxer( 'DTFTRI', infot, nout, lerr, ok )
169  infot = 4
170  CALL dtftri( 'N', 'L', 'N', -1, a, info )
171  CALL chkxer( 'DTFTRI', infot, nout, lerr, ok )
172 *
173  srnamt = 'DTFTTR'
174  infot = 1
175  CALL dtfttr( '/', 'U', 0, a, b, 1, info )
176  CALL chkxer( 'DTFTTR', infot, nout, lerr, ok )
177  infot = 2
178  CALL dtfttr( 'N', '/', 0, a, b, 1, info )
179  CALL chkxer( 'DTFTTR', infot, nout, lerr, ok )
180  infot = 3
181  CALL dtfttr( 'N', 'U', -1, a, b, 1, info )
182  CALL chkxer( 'DTFTTR', infot, nout, lerr, ok )
183  infot = 6
184  CALL dtfttr( 'N', 'U', 0, a, b, 0, info )
185  CALL chkxer( 'DTFTTR', infot, nout, lerr, ok )
186 *
187  srnamt = 'DTRTTF'
188  infot = 1
189  CALL dtrttf( '/', 'U', 0, a, 1, b, info )
190  CALL chkxer( 'DTRTTF', infot, nout, lerr, ok )
191  infot = 2
192  CALL dtrttf( 'N', '/', 0, a, 1, b, info )
193  CALL chkxer( 'DTRTTF', infot, nout, lerr, ok )
194  infot = 3
195  CALL dtrttf( 'N', 'U', -1, a, 1, b, info )
196  CALL chkxer( 'DTRTTF', infot, nout, lerr, ok )
197  infot = 5
198  CALL dtrttf( 'N', 'U', 0, a, 0, b, info )
199  CALL chkxer( 'DTRTTF', infot, nout, lerr, ok )
200 *
201  srnamt = 'DTFTTP'
202  infot = 1
203  CALL dtfttp( '/', 'U', 0, a, b, info )
204  CALL chkxer( 'DTFTTP', infot, nout, lerr, ok )
205  infot = 2
206  CALL dtfttp( 'N', '/', 0, a, b, info )
207  CALL chkxer( 'DTFTTP', infot, nout, lerr, ok )
208  infot = 3
209  CALL dtfttp( 'N', 'U', -1, a, b, info )
210  CALL chkxer( 'DTFTTP', infot, nout, lerr, ok )
211 *
212  srnamt = 'DTPTTF'
213  infot = 1
214  CALL dtpttf( '/', 'U', 0, a, b, info )
215  CALL chkxer( 'DTPTTF', infot, nout, lerr, ok )
216  infot = 2
217  CALL dtpttf( 'N', '/', 0, a, b, info )
218  CALL chkxer( 'DTPTTF', infot, nout, lerr, ok )
219  infot = 3
220  CALL dtpttf( 'N', 'U', -1, a, b, info )
221  CALL chkxer( 'DTPTTF', infot, nout, lerr, ok )
222 *
223  srnamt = 'DTRTTP'
224  infot = 1
225  CALL dtrttp( '/', 0, a, 1, b, info )
226  CALL chkxer( 'DTRTTP', infot, nout, lerr, ok )
227  infot = 2
228  CALL dtrttp( 'U', -1, a, 1, b, info )
229  CALL chkxer( 'DTRTTP', infot, nout, lerr, ok )
230  infot = 4
231  CALL dtrttp( 'U', 0, a, 0, b, info )
232  CALL chkxer( 'DTRTTP', infot, nout, lerr, ok )
233 *
234  srnamt = 'DTPTTR'
235  infot = 1
236  CALL dtpttr( '/', 0, a, b, 1, info )
237  CALL chkxer( 'DTPTTR', infot, nout, lerr, ok )
238  infot = 2
239  CALL dtpttr( 'U', -1, a, b, 1, info )
240  CALL chkxer( 'DTPTTR', infot, nout, lerr, ok )
241  infot = 5
242  CALL dtpttr( 'U', 0, a, b, 0, info )
243  CALL chkxer( 'DTPTTR', infot, nout, lerr, ok )
244 *
245  srnamt = 'DSFRK '
246  infot = 1
247  CALL dsfrk( '/', 'U', 'N', 0, 0, alpha, a, 1, beta, b )
248  CALL chkxer( 'DSFRK ', infot, nout, lerr, ok )
249  infot = 2
250  CALL dsfrk( 'N', '/', 'N', 0, 0, alpha, a, 1, beta, b )
251  CALL chkxer( 'DSFRK ', infot, nout, lerr, ok )
252  infot = 3
253  CALL dsfrk( 'N', 'U', '/', 0, 0, alpha, a, 1, beta, b )
254  CALL chkxer( 'DSFRK ', infot, nout, lerr, ok )
255  infot = 4
256  CALL dsfrk( 'N', 'U', 'N', -1, 0, alpha, a, 1, beta, b )
257  CALL chkxer( 'DSFRK ', infot, nout, lerr, ok )
258  infot = 5
259  CALL dsfrk( 'N', 'U', 'N', 0, -1, alpha, a, 1, beta, b )
260  CALL chkxer( 'DSFRK ', infot, nout, lerr, ok )
261  infot = 8
262  CALL dsfrk( 'N', 'U', 'N', 0, 0, alpha, a, 0, beta, b )
263  CALL chkxer( 'DSFRK ', 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, 'DOUBLE PRECISION 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 DERRRFP
280 *
281  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine derrrfp(NUNIT)
DERRRFP
Definition: derrrfp.f:52
subroutine dtrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: dtrttf.f:194
subroutine dpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
DPFTRS
Definition: dpftrs.f:199
subroutine dtpttr(UPLO, N, AP, A, LDA, INFO)
DTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
Definition: dtpttr.f:104
subroutine dtrttp(UPLO, N, A, LDA, AP, INFO)
DTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...
Definition: dtrttp.f:104
subroutine dtpttf(TRANSR, UPLO, N, AP, ARF, INFO)
DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
Definition: dtpttf.f:186
subroutine dtftri(TRANSR, UPLO, DIAG, N, A, INFO)
DTFTRI
Definition: dtftri.f:201
subroutine dsfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
DSFRK performs a symmetric rank-k operation for matrix in RFP format.
Definition: dsfrk.f:166
subroutine dpftri(TRANSR, UPLO, N, A, INFO)
DPFTRI
Definition: dpftri.f:191
subroutine dtfsm(TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, B, LDB)
DTFSM solves a matrix equation (one operand is a triangular matrix in RFP format).
Definition: dtfsm.f:277
subroutine dpftrf(TRANSR, UPLO, N, A, INFO)
DPFTRF
Definition: dpftrf.f:198
subroutine dtfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition: dtfttr.f:196
subroutine dtfttp(TRANSR, UPLO, N, ARF, AP, INFO)
DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
Definition: dtfttp.f:187