217 SUBROUTINE ctfttr( TRANSR, UPLO, N, ARF, A, LDA, INFO )
225 CHARACTER transr, uplo
229 COMPLEX a( 0: lda-1, 0: * ), arf( 0: * )
237 LOGICAL lower, nisodd, normaltransr
238 INTEGER n1, n2, k, nt, nx2, np1x2
249 INTRINSIC conjg, max, mod
256 normaltransr =
lsame( transr,
'N' )
257 lower =
lsame( uplo,
'L' )
258 IF( .NOT.normaltransr .AND. .NOT.
lsame( transr,
'C' ) )
THEN
260 ELSE IF( .NOT.lower .AND. .NOT.
lsame( uplo,
'U' ) )
THEN
262 ELSE IF( n.LT.0 )
THEN
264 ELSE IF( lda.LT.max( 1, n ) )
THEN
268 CALL
xerbla(
'CTFTTR', -info )
276 IF( normaltransr )
THEN
279 a( 0, 0 ) = conjg( arf( 0 ) )
303 IF( mod( n, 2 ).EQ.0 )
THEN
318 IF( normaltransr )
THEN
331 a( n2+
j, i ) = conjg( arf( ij ) )
335 a( i,
j ) = arf( ij )
349 a( i,
j ) = arf( ij )
352 DO l =
j - n1, n1 - 1
353 a(
j-n1, l ) = conjg( arf( ij ) )
374 a(
j, i ) = conjg( arf( ij ) )
378 a( i, n1+
j ) = arf( ij )
384 a(
j, i ) = conjg( arf( ij ) )
398 a(
j, i ) = conjg( arf( ij ) )
404 a( i,
j ) = arf( ij )
408 a( n2+
j, l ) = conjg( arf( ij ) )
421 IF( normaltransr )
THEN
434 a( k+
j, i ) = conjg( arf( ij ) )
438 a( i,
j ) = arf( ij )
452 a( i,
j ) = arf( ij )
456 a(
j-k, l ) = conjg( arf( ij ) )
477 a( i,
j ) = arf( ij )
482 a(
j, i ) = conjg( arf( ij ) )
485 DO i = k + 1 +
j, n - 1
486 a( i, k+1+
j ) = arf( ij )
492 a(
j, i ) = conjg( arf( ij ) )
506 a(
j, i ) = conjg( arf( ij ) )
512 a( i,
j ) = arf( ij )
515 DO l = k + 1 +
j, n - 1
516 a( k+1+
j, l ) = conjg( arf( ij ) )
524 a( i,
j ) = arf( ij )
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine ctfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j