LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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,
73 + dpftri, dpftrf, dpftrs, dtpttf, dtpttr, dtrttf,
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*
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
dsfrk
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
dpftrf
subroutine dpftrf(transr, uplo, n, a, info)
DPFTRF
Definition dpftrf.f:198
dpftri
subroutine dpftri(transr, uplo, n, a, info)
DPFTRI
Definition dpftri.f:191
dpftrs
subroutine dpftrs(transr, uplo, n, nrhs, a, b, ldb, info)
DPFTRS
Definition dpftrs.f:199
dtfsm
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
dtftri
subroutine dtftri(transr, uplo, diag, n, a, info)
DTFTRI
Definition dtftri.f:201
dtfttp
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
dtfttr
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
dtpttf
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
dtpttr
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
dtrttf
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
dtrttp
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
Here is the call graph for this function:
Here is the caller graph for this function: