1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
SUBROUTINE DTRT01( UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND,
$ WORK, RESID )
*
* -- LAPACK test routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* February 29, 1992
*
* .. Scalar Arguments ..
CHARACTER DIAG, UPLO
INTEGER LDA, LDAINV, N
DOUBLE PRECISION RCOND, RESID
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), AINV( LDAINV, * ), WORK( * )
* ..
*
* Purpose
* =======
*
* DTRT01 computes the residual for a triangular matrix A times its
* inverse:
* RESID = norm( A*AINV - I ) / ( N * norm(A) * norm(AINV) * EPS ),
* where EPS is the machine epsilon.
*
* Arguments
* ==========
*
* UPLO (input) CHARACTER*1
* Specifies whether the matrix A is upper or lower triangular.
* = 'U': Upper triangular
* = 'L': Lower triangular
*
* DIAG (input) CHARACTER*1
* Specifies whether or not the matrix A is unit triangular.
* = 'N': Non-unit triangular
* = 'U': Unit triangular
*
* N (input) INTEGER
* The order of the matrix A. N >= 0.
*
* A (input) DOUBLE PRECISION array, dimension (LDA,N)
* The triangular matrix A. If UPLO = 'U', the leading n by n
* upper triangular part of the array A contains the upper
* triangular matrix, and the strictly lower triangular part of
* A is not referenced. If UPLO = 'L', the leading n by n lower
* triangular part of the array A contains the lower triangular
* matrix, and the strictly upper triangular part of A is not
* referenced. If DIAG = 'U', the diagonal elements of A are
* also not referenced and are assumed to be 1.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,N).
*
* AINV (input/output) DOUBLE PRECISION array, dimension (LDAINV,N)
* On entry, the (triangular) inverse of the matrix A, in the
* same storage format as A.
* On exit, the contents of AINV are destroyed.
*
* LDAINV (input) INTEGER
* The leading dimension of the array AINV. LDAINV >= max(1,N).
*
* RCOND (output) DOUBLE PRECISION
* The reciprocal condition number of A, computed as
* 1/(norm(A) * norm(AINV)).
*
* WORK (workspace) DOUBLE PRECISION array, dimension (N)
*
* RESID (output) DOUBLE PRECISION
* norm(A*AINV - I) / ( N * norm(A) * norm(AINV) * EPS )
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
INTEGER J
DOUBLE PRECISION AINVNM, ANORM, EPS
* ..
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH, DLANTR
EXTERNAL LSAME, DLAMCH, DLANTR
* ..
* .. External Subroutines ..
EXTERNAL DTRMV
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE
* ..
* .. Executable Statements ..
*
* Quick exit if N = 0
*
IF( N.LE.0 ) THEN
RCOND = ONE
RESID = ZERO
RETURN
END IF
*
* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0.
*
EPS = DLAMCH( 'Epsilon' )
ANORM = DLANTR( '1', UPLO, DIAG, N, N, A, LDA, WORK )
AINVNM = DLANTR( '1', UPLO, DIAG, N, N, AINV, LDAINV, WORK )
IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
RCOND = ZERO
RESID = ONE / EPS
RETURN
END IF
RCOND = ( ONE / ANORM ) / AINVNM
*
* Set the diagonal of AINV to 1 if AINV has unit diagonal.
*
IF( LSAME( DIAG, 'U' ) ) THEN
DO 10 J = 1, N
AINV( J, J ) = ONE
10 CONTINUE
END IF
*
* Compute A * AINV, overwriting AINV.
*
IF( LSAME( UPLO, 'U' ) ) THEN
DO 20 J = 1, N
CALL DTRMV( 'Upper', 'No transpose', DIAG, J, A, LDA,
$ AINV( 1, J ), 1 )
20 CONTINUE
ELSE
DO 30 J = 1, N
CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J+1, A( J, J ),
$ LDA, AINV( J, J ), 1 )
30 CONTINUE
END IF
*
* Subtract 1 from each diagonal element to form A*AINV - I.
*
DO 40 J = 1, N
AINV( J, J ) = AINV( J, J ) - ONE
40 CONTINUE
*
* Compute norm(A*AINV - I) / (N * norm(A) * norm(AINV) * EPS)
*
RESID = DLANTR( '1', UPLO, 'Non-unit', N, N, AINV, LDAINV, WORK )
*
RESID = ( ( RESID*RCOND ) / DBLE( N ) ) / EPS
*
RETURN
*
* End of DTRT01
*
END
|
