OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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,
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*
281 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
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
dpftri
subroutine dpftri(transr, uplo, n, a, info)
DPFTRI
Definition dpftri.f:191
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
dpftrf
subroutine dpftrf(transr, uplo, n, a, info)
DPFTRF
Definition dpftrf.f:198
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
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
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
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
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
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
dpftrs
subroutine dpftrs(transr, uplo, n, nrhs, a, b, ldb, info)
DPFTRS
Definition dpftrs.f:199
derrrfp
subroutine derrrfp(nunit)
DERRRFP
Definition derrrfp.f:52