213 SUBROUTINE cpftri( TRANSR, UPLO, N, A, INFO )
221 CHARACTER transr, uplo
232 parameter( one = 1.0e+0, cone = ( 1.0e+0, 0.0e+0 ) )
235 LOGICAL lower, nisodd, normaltransr
253 normaltransr =
lsame( transr,
'N' )
254 lower =
lsame( uplo,
'L' )
255 IF( .NOT.normaltransr .AND. .NOT.
lsame( transr,
'C' ) )
THEN
257 ELSE IF( .NOT.lower .AND. .NOT.
lsame( uplo,
'U' ) )
THEN
259 ELSE IF( n.LT.0 )
THEN
263 CALL
xerbla(
'CPFTRI', -info )
274 CALL
ctftri( transr, uplo,
'N', n, a, info )
281 IF( mod( n, 2 ).EQ.0 )
THEN
305 IF( normaltransr )
THEN
315 CALL
clauum(
'L', n1, a( 0 ), n, info )
316 CALL
cherk(
'L',
'C', n1, n2, one, a( n1 ), n, one,
318 CALL
ctrmm(
'L',
'U',
'N',
'N', n2, n1, cone, a( n ), n,
320 CALL
clauum(
'U', n2, a( n ), n, info )
328 CALL
clauum(
'L', n1, a( n2 ), n, info )
329 CALL
cherk(
'L',
'N', n1, n2, one, a( 0 ), n, one,
331 CALL
ctrmm(
'R',
'U',
'C',
'N', n1, n2, cone, a( n1 ), n,
333 CALL
clauum(
'U', n2, a( n1 ), n, info )
346 CALL
clauum(
'U', n1, a( 0 ), n1, info )
347 CALL
cherk(
'U',
'N', n1, n2, one, a( n1*n1 ), n1, one,
349 CALL
ctrmm(
'R',
'L',
'N',
'N', n1, n2, cone, a( 1 ), n1,
351 CALL
clauum(
'L', n2, a( 1 ), n1, info )
358 CALL
clauum(
'U', n1, a( n2*n2 ), n2, info )
359 CALL
cherk(
'U',
'C', n1, n2, one, a( 0 ), n2, one,
361 CALL
ctrmm(
'L',
'L',
'C',
'N', n2, n1, cone, a( n1*n2 ),
363 CALL
clauum(
'L', n2, a( n1*n2 ), n2, info )
373 IF( normaltransr )
THEN
383 CALL
clauum(
'L', k, a( 1 ), n+1, info )
384 CALL
cherk(
'L',
'C', k, k, one, a( k+1 ), n+1, one,
386 CALL
ctrmm(
'L',
'U',
'N',
'N', k, k, cone, a( 0 ), n+1,
388 CALL
clauum(
'U', k, a( 0 ), n+1, info )
396 CALL
clauum(
'L', k, a( k+1 ), n+1, info )
397 CALL
cherk(
'L',
'N', k, k, one, a( 0 ), n+1, one,
399 CALL
ctrmm(
'R',
'U',
'C',
'N', k, k, cone, a( k ), n+1,
401 CALL
clauum(
'U', k, a( k ), n+1, info )
415 CALL
clauum(
'U', k, a( k ), k, info )
416 CALL
cherk(
'U',
'N', k, k, one, a( k*( k+1 ) ), k, one,
418 CALL
ctrmm(
'R',
'L',
'N',
'N', k, k, cone, a( 0 ), k,
419 $ a( k*( k+1 ) ), k )
420 CALL
clauum(
'L', k, a( 0 ), k, info )
428 CALL
clauum(
'U', k, a( k*( k+1 ) ), k, info )
429 CALL
cherk(
'U',
'C', k, k, one, a( 0 ), k, one,
430 $ a( k*( k+1 ) ), k )
431 CALL
ctrmm(
'L',
'L',
'C',
'N', k, k, cone, a( k*k ), k,
433 CALL
clauum(
'L', k, a( k*k ), k, info )
subroutine clauum(UPLO, N, A, LDA, INFO)
CLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked...
subroutine ctftri(TRANSR, UPLO, DIAG, N, A, INFO)
CTFTRI
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
logical function lsame(CA, CB)
LSAME
subroutine cpftri(TRANSR, UPLO, N, A, INFO)
CPFTRI
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK