Go to the documentation of this file.00001 SUBROUTINE ZPPTRI( UPLO, N, AP, INFO )
00002
00003
00004
00005
00006
00007
00008
00009 CHARACTER UPLO
00010 INTEGER INFO, N
00011
00012
00013 COMPLEX*16 AP( * )
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053 DOUBLE PRECISION ONE
00054 PARAMETER ( ONE = 1.0D+0 )
00055
00056
00057 LOGICAL UPPER
00058 INTEGER J, JC, JJ, JJN
00059 DOUBLE PRECISION AJJ
00060
00061
00062 LOGICAL LSAME
00063 COMPLEX*16 ZDOTC
00064 EXTERNAL LSAME, ZDOTC
00065
00066
00067 EXTERNAL XERBLA, ZDSCAL, ZHPR, ZTPMV, ZTPTRI
00068
00069
00070 INTRINSIC DBLE
00071
00072
00073
00074
00075
00076 INFO = 0
00077 UPPER = LSAME( UPLO, 'U' )
00078 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00079 INFO = -1
00080 ELSE IF( N.LT.0 ) THEN
00081 INFO = -2
00082 END IF
00083 IF( INFO.NE.0 ) THEN
00084 CALL XERBLA( 'ZPPTRI', -INFO )
00085 RETURN
00086 END IF
00087
00088
00089
00090 IF( N.EQ.0 )
00091 $ RETURN
00092
00093
00094
00095 CALL ZTPTRI( UPLO, 'Non-unit', N, AP, INFO )
00096 IF( INFO.GT.0 )
00097 $ RETURN
00098 IF( UPPER ) THEN
00099
00100
00101
00102 JJ = 0
00103 DO 10 J = 1, N
00104 JC = JJ + 1
00105 JJ = JJ + J
00106 IF( J.GT.1 )
00107 $ CALL ZHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP )
00108 AJJ = AP( JJ )
00109 CALL ZDSCAL( J, AJJ, AP( JC ), 1 )
00110 10 CONTINUE
00111
00112 ELSE
00113
00114
00115
00116 JJ = 1
00117 DO 20 J = 1, N
00118 JJN = JJ + N - J + 1
00119 AP( JJ ) = DBLE( ZDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) )
00120 IF( J.LT.N )
00121 $ CALL ZTPMV( 'Lower', 'Conjugate transpose', 'Non-unit',
00122 $ N-J, AP( JJN ), AP( JJ+1 ), 1 )
00123 JJ = JJN
00124 20 CONTINUE
00125 END IF
00126
00127 RETURN
00128
00129
00130
00131 END