192 SUBROUTINE spftri( TRANSR, UPLO, N, A, INFO )
200 CHARACTER transr, uplo
210 parameter( one = 1.0e+0 )
213 LOGICAL lower, nisodd, normaltransr
231 normaltransr =
lsame( transr,
'N' )
232 lower =
lsame( uplo,
'L' )
233 IF( .NOT.normaltransr .AND. .NOT.
lsame( transr,
'T' ) )
THEN
235 ELSE IF( .NOT.lower .AND. .NOT.
lsame( uplo,
'U' ) )
THEN
237 ELSE IF( n.LT.0 )
THEN
241 CALL
xerbla(
'SPFTRI', -info )
252 CALL
stftri( transr, uplo,
'N', n, a, info )
259 IF( mod( n, 2 ).EQ.0 )
THEN
283 IF( normaltransr )
THEN
293 CALL
slauum(
'L', n1, a( 0 ), n, info )
294 CALL
ssyrk(
'L',
'T', n1, n2, one, a( n1 ), n, one,
296 CALL
strmm(
'L',
'U',
'N',
'N', n2, n1, one, a( n ), n,
298 CALL
slauum(
'U', n2, a( n ), n, info )
306 CALL
slauum(
'L', n1, a( n2 ), n, info )
307 CALL
ssyrk(
'L',
'N', n1, n2, one, a( 0 ), n, one,
309 CALL
strmm(
'R',
'U',
'T',
'N', n1, n2, one, a( n1 ), n,
311 CALL
slauum(
'U', n2, a( n1 ), n, info )
324 CALL
slauum(
'U', n1, a( 0 ), n1, info )
325 CALL
ssyrk(
'U',
'N', n1, n2, one, a( n1*n1 ), n1, one,
327 CALL
strmm(
'R',
'L',
'N',
'N', n1, n2, one, a( 1 ), n1,
329 CALL
slauum(
'L', n2, a( 1 ), n1, info )
336 CALL
slauum(
'U', n1, a( n2*n2 ), n2, info )
337 CALL
ssyrk(
'U',
'T', n1, n2, one, a( 0 ), n2, one,
339 CALL
strmm(
'L',
'L',
'T',
'N', n2, n1, one, a( n1*n2 ),
341 CALL
slauum(
'L', n2, a( n1*n2 ), n2, info )
351 IF( normaltransr )
THEN
361 CALL
slauum(
'L', k, a( 1 ), n+1, info )
362 CALL
ssyrk(
'L',
'T', k, k, one, a( k+1 ), n+1, one,
364 CALL
strmm(
'L',
'U',
'N',
'N', k, k, one, a( 0 ), n+1,
366 CALL
slauum(
'U', k, a( 0 ), n+1, info )
374 CALL
slauum(
'L', k, a( k+1 ), n+1, info )
375 CALL
ssyrk(
'L',
'N', k, k, one, a( 0 ), n+1, one,
377 CALL
strmm(
'R',
'U',
'T',
'N', k, k, one, a( k ), n+1,
379 CALL
slauum(
'U', k, a( k ), n+1, info )
393 CALL
slauum(
'U', k, a( k ), k, info )
394 CALL
ssyrk(
'U',
'N', k, k, one, a( k*( k+1 ) ), k, one,
396 CALL
strmm(
'R',
'L',
'N',
'N', k, k, one, a( 0 ), k,
397 $ a( k*( k+1 ) ), k )
398 CALL
slauum(
'L', k, a( 0 ), k, info )
406 CALL
slauum(
'U', k, a( k*( k+1 ) ), k, info )
407 CALL
ssyrk(
'U',
'T', k, k, one, a( 0 ), k, one,
408 $ a( k*( k+1 ) ), k )
409 CALL
strmm(
'L',
'L',
'T',
'N', k, k, one, a( k*k ), k,
411 CALL
slauum(
'L', k, a( k*k ), k, info )
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slauum(UPLO, N, A, LDA, INFO)
SLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
logical function lsame(CA, CB)
LSAME
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRMM
subroutine spftri(TRANSR, UPLO, N, A, INFO)
SPFTRI
subroutine stftri(TRANSR, UPLO, DIAG, N, A, INFO)
STFTRI