102 DOUBLE PRECISION a( lda, * ), arf( * ), ap(*), asav( lda, * )
108 LOGICAL lower, ok1, ok2
109 CHARACTER uplo, cform
110 INTEGER i, iform, iin, info, iuplo, j, n,
114 CHARACTER uplos( 2 ), forms( 2 )
115 INTEGER iseed( 4 ), iseedy( 4 )
128 COMMON / srnamc / srnamt
131 DATA iseedy / 1988, 1989, 1990, 1991 /
132 DATA uplos /
'U',
'L' /
133 DATA forms /
'N',
'T' /
143 iseed( i ) = iseedy( i )
154 uplo = uplos( iuplo )
156 IF ( iuplo.EQ.1 ) lower = .false.
162 cform = forms( iform )
168 a( i, j) =
dlarnd( 2, iseed )
173 CALL dtrttf( cform, uplo, n, a, lda, arf, info )
176 CALL dtfttp( cform, uplo, n, arf, ap, info )
179 CALL dtpttr( uplo, n, ap, asav, lda, info )
185 IF ( a(i,j).NE.asav(i,j) )
THEN
193 IF ( a(i,j).NE.asav(i,j) )
THEN
203 CALL dtrttp( uplo, n, a, lda, ap, info )
206 CALL dtpttf( cform, uplo, n, ap, arf, info )
209 CALL dtfttr( cform, uplo, n, arf, asav, lda, info )
215 IF ( a(i,j).NE.asav(i,j) )
THEN
223 IF ( a(i,j).NE.asav(i,j) )
THEN
230 IF (( .NOT.ok1 ).OR.( .NOT.ok2 ))
THEN
231 IF( nerrs.EQ.0 )
THEN
233 WRITE( nout, fmt = 9999 )
235 WRITE( nout, fmt = 9998 ) n, uplo, cform
245 IF ( nerrs.EQ.0 )
THEN
246 WRITE( nout, fmt = 9997 ) nrun
248 WRITE( nout, fmt = 9996 ) nerrs, nrun
251 9999
FORMAT( 1x,
' *** Error(s) while testing the RFP convertion',
253 9998
FORMAT( 1x,
' Error in RFP,convertion routines N=',i5,
254 +
' UPLO=''', a1,
''', FORM =''',a1,
'''')
255 9997
FORMAT( 1x,
'All tests for the RFP convertion routines passed ( ',
257 9996
FORMAT( 1x,
'RFP convertion routines: ',i5,
' out of ',i5,
258 +
' error message recorded')
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 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...
double precision function dlarnd(IDIST, ISEED)
DLARND
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 dtfttp(TRANSR, UPLO, N, ARF, AP, INFO)
DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
subroutine dtpttf(TRANSR, UPLO, N, AP, ARF, INFO)
DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...