LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ derrrfp()

subroutine derrrfp ( integer  NUNIT)

DERRRFP

Purpose:
 DERRRFP tests the error exits for the DOUBLE PRECISION driver routines
 for solving linear systems of equations.

 DDRVRFP tests the DOUBLE PRECISION LAPACK RFP routines:
     DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, DPFTRF, DPFTRS, DTPTTF,
     DTPTTR, DTRTTF, and DTRTTP
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 derrrfp.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  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 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
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
Here is the call graph for this function:
Here is the caller graph for this function: