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 slauum(UPLO, N, A, LDA, INFO)
SLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
subroutine stftri(TRANSR, UPLO, DIAG, N, A, INFO)
STFTRI
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine spftri(TRANSR, UPLO, N, A, INFO)
SPFTRI