102 REAL 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) =
slarnd( 2, iseed )
173 CALL strttf( cform, uplo, n, a, lda, arf, info )
176 CALL stfttp( cform, uplo, n, arf, ap, info )
179 CALL stpttr( 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 strttp( uplo, n, a, lda, ap, info )
206 CALL stpttf( cform, uplo, n, ap, arf, info )
209 CALL stfttr( 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 conversion',
253 9998
FORMAT( 1x,
' Error in RFP,conversion routines N=',i5,
254 +
' UPLO=''', a1,
''', FORM =''',a1,
'''')
255 9997
FORMAT( 1x,
'All tests for the RFP conversion routines passed ( ',
257 9996
FORMAT( 1x,
'RFP conversion routines: ',i5,
' out of ',i5,
258 +
' error message recorded')
subroutine strttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
subroutine stfttp(TRANSR, UPLO, N, ARF, AP, INFO)
STFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
subroutine stpttr(UPLO, N, AP, A, LDA, INFO)
STPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
subroutine stfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
real function slarnd(IDIST, ISEED)
SLARND
subroutine stpttf(TRANSR, UPLO, N, AP, ARF, INFO)
STPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
subroutine strttp(UPLO, N, A, LDA, AP, INFO)
STRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...