69 DOUBLE PRECISION alpha, beta
72 DOUBLE PRECISION a( 1, 1),
b( 1, 1)
85 COMMON / infoc / infot, nout, ok, lerr
86 COMMON / srnamc / srnamt
99 CALL
dpftrf(
'/',
'U', 0, a, info )
100 CALL
chkxer(
'DPFTRF', infot, nout, lerr, ok )
102 CALL
dpftrf(
'N',
'/', 0, a, info )
103 CALL
chkxer(
'DPFTRF', infot, nout, lerr, ok )
105 CALL
dpftrf(
'N',
'U', -1, a, info )
106 CALL
chkxer(
'DPFTRF', infot, nout, lerr, ok )
110 CALL
dpftrs(
'/',
'U', 0, 0, a,
b, 1, info )
111 CALL
chkxer(
'DPFTRS', infot, nout, lerr, ok )
113 CALL
dpftrs(
'N',
'/', 0, 0, a,
b, 1, info )
114 CALL
chkxer(
'DPFTRS', infot, nout, lerr, ok )
116 CALL
dpftrs(
'N',
'U', -1, 0, a,
b, 1, info )
117 CALL
chkxer(
'DPFTRS', infot, nout, lerr, ok )
119 CALL
dpftrs(
'N',
'U', 0, -1, a,
b, 1, info )
120 CALL
chkxer(
'DPFTRS', infot, nout, lerr, ok )
122 CALL
dpftrs(
'N',
'U', 0, 0, a,
b, 0, info )
123 CALL
chkxer(
'DPFTRS', infot, nout, lerr, ok )
127 CALL
dpftri(
'/',
'U', 0, a, info )
128 CALL
chkxer(
'DPFTRI', infot, nout, lerr, ok )
130 CALL
dpftri(
'N',
'/', 0, a, info )
131 CALL
chkxer(
'DPFTRI', infot, nout, lerr, ok )
133 CALL
dpftri(
'N',
'U', -1, a, info )
134 CALL
chkxer(
'DPFTRI', infot, nout, lerr, ok )
138 CALL
dtfsm(
'/',
'L',
'U',
'T',
'U', 0, 0, alpha, a,
b, 1 )
139 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
141 CALL
dtfsm(
'N',
'/',
'U',
'T',
'U', 0, 0, alpha, a,
b, 1 )
142 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
144 CALL
dtfsm(
'N',
'L',
'/',
'T',
'U', 0, 0, alpha, a,
b, 1 )
145 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
147 CALL
dtfsm(
'N',
'L',
'U',
'/',
'U', 0, 0, alpha, a,
b, 1 )
148 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
150 CALL
dtfsm(
'N',
'L',
'U',
'T',
'/', 0, 0, alpha, a,
b, 1 )
151 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
153 CALL
dtfsm(
'N',
'L',
'U',
'T',
'U', -1, 0, alpha, a,
b, 1 )
154 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
156 CALL
dtfsm(
'N',
'L',
'U',
'T',
'U', 0, -1, alpha, a,
b, 1 )
157 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
159 CALL
dtfsm(
'N',
'L',
'U',
'T',
'U', 0, 0, alpha, a,
b, 0 )
160 CALL
chkxer(
'DTFSM ', infot, nout, lerr, ok )
164 CALL
dtftri(
'/',
'L',
'N', 0, a, info )
165 CALL
chkxer(
'DTFTRI', infot, nout, lerr, ok )
167 CALL
dtftri(
'N',
'/',
'N', 0, a, info )
168 CALL
chkxer(
'DTFTRI', infot, nout, lerr, ok )
170 CALL
dtftri(
'N',
'L',
'/', 0, a, info )
171 CALL
chkxer(
'DTFTRI', infot, nout, lerr, ok )
173 CALL
dtftri(
'N',
'L',
'N', -1, a, info )
174 CALL
chkxer(
'DTFTRI', infot, nout, lerr, ok )
178 CALL
dtfttr(
'/',
'U', 0, a,
b, 1, info )
179 CALL
chkxer(
'DTFTTR', infot, nout, lerr, ok )
181 CALL
dtfttr(
'N',
'/', 0, a,
b, 1, info )
182 CALL
chkxer(
'DTFTTR', infot, nout, lerr, ok )
184 CALL
dtfttr(
'N',
'U', -1, a,
b, 1, info )
185 CALL
chkxer(
'DTFTTR', infot, nout, lerr, ok )
187 CALL
dtfttr(
'N',
'U', 0, a,
b, 0, info )
188 CALL
chkxer(
'DTFTTR', infot, nout, lerr, ok )
192 CALL
dtrttf(
'/',
'U', 0, a, 1,
b, info )
193 CALL
chkxer(
'DTRTTF', infot, nout, lerr, ok )
195 CALL
dtrttf(
'N',
'/', 0, a, 1,
b, info )
196 CALL
chkxer(
'DTRTTF', infot, nout, lerr, ok )
198 CALL
dtrttf(
'N',
'U', -1, a, 1,
b, info )
199 CALL
chkxer(
'DTRTTF', infot, nout, lerr, ok )
201 CALL
dtrttf(
'N',
'U', 0, a, 0,
b, info )
202 CALL
chkxer(
'DTRTTF', infot, nout, lerr, ok )
206 CALL
dtfttp(
'/',
'U', 0, a,
b, info )
207 CALL
chkxer(
'DTFTTP', infot, nout, lerr, ok )
209 CALL
dtfttp(
'N',
'/', 0, a,
b, info )
210 CALL
chkxer(
'DTFTTP', infot, nout, lerr, ok )
212 CALL
dtfttp(
'N',
'U', -1, a,
b, info )
213 CALL
chkxer(
'DTFTTP', infot, nout, lerr, ok )
217 CALL
dtpttf(
'/',
'U', 0, a,
b, info )
218 CALL
chkxer(
'DTPTTF', infot, nout, lerr, ok )
220 CALL
dtpttf(
'N',
'/', 0, a,
b, info )
221 CALL
chkxer(
'DTPTTF', infot, nout, lerr, ok )
223 CALL
dtpttf(
'N',
'U', -1, a,
b, info )
224 CALL
chkxer(
'DTPTTF', infot, nout, lerr, ok )
228 CALL
dtrttp(
'/', 0, a, 1,
b, info )
229 CALL
chkxer(
'DTRTTP', infot, nout, lerr, ok )
231 CALL
dtrttp(
'U', -1, a, 1,
b, info )
232 CALL
chkxer(
'DTRTTP', infot, nout, lerr, ok )
234 CALL
dtrttp(
'U', 0, a, 0,
b, info )
235 CALL
chkxer(
'DTRTTP', infot, nout, lerr, ok )
239 CALL
dtpttr(
'/', 0, a,
b, 1, info )
240 CALL
chkxer(
'DTPTTR', infot, nout, lerr, ok )
242 CALL
dtpttr(
'U', -1, a,
b, 1, info )
243 CALL
chkxer(
'DTPTTR', infot, nout, lerr, ok )
245 CALL
dtpttr(
'U', 0, a,
b, 0, info )
246 CALL
chkxer(
'DTPTTR', infot, nout, lerr, ok )
250 CALL
dsfrk(
'/',
'U',
'N', 0, 0, alpha, a, 1, beta,
b )
251 CALL
chkxer(
'DSFRK ', infot, nout, lerr, ok )
253 CALL
dsfrk(
'N',
'/',
'N', 0, 0, alpha, a, 1, beta,
b )
254 CALL
chkxer(
'DSFRK ', infot, nout, lerr, ok )
256 CALL
dsfrk(
'N',
'U',
'/', 0, 0, alpha, a, 1, beta,
b )
257 CALL
chkxer(
'DSFRK ', infot, nout, lerr, ok )
259 CALL
dsfrk(
'N',
'U',
'N', -1, 0, alpha, a, 1, beta,
b )
260 CALL
chkxer(
'DSFRK ', infot, nout, lerr, ok )
262 CALL
dsfrk(
'N',
'U',
'N', 0, -1, alpha, a, 1, beta,
b )
263 CALL
chkxer(
'DSFRK ', infot, nout, lerr, ok )
265 CALL
dsfrk(
'N',
'U',
'N', 0, 0, alpha, a, 0, beta,
b )
266 CALL
chkxer(
'DSFRK ', infot, nout, lerr, ok )
271 WRITE( nout, fmt = 9999 )
273 WRITE( nout, fmt = 9998 )
276 9999
FORMAT( 1x,
'DOUBLE PRECISION RFP routines passed the tests of ',
277 $
'the error exits' )
278 9998
FORMAT(
' *** RFP routines failed the tests of the error ',
subroutine dpftri(TRANSR, UPLO, N, A, INFO)
DPFTRI
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...
subroutine dtfttp(TRANSR, UPLO, N, ARF, AP, INFO)
DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
subroutine derrrfp(NUNIT)
DERRRFP
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...
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
DPFTRS
subroutine dsfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
DSFRK performs a symmetric rank-k operation for matrix in RFP format.
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...
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...
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).
subroutine dtftri(TRANSR, UPLO, DIAG, N, A, INFO)
DTFTRI
subroutine dtpttf(TRANSR, UPLO, N, AP, ARF, INFO)
DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
subroutine dpftrf(TRANSR, UPLO, N, A, INFO)
DPFTRF