1*> \brief \b SGET03
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE SGET03( N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK,
12*                          RCOND, RESID )
13*
14*       .. Scalar Arguments ..
15*       INTEGER            LDA, LDAINV, LDWORK, N
16*       REAL               RCOND, RESID
17*       ..
18*       .. Array Arguments ..
19*       REAL               A( LDA, * ), AINV( LDAINV, * ), RWORK( * ),
20*      $                   WORK( LDWORK, * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> SGET03 computes the residual for a general matrix times its inverse:
30*>    norm( I - AINV*A ) / ( N * norm(A) * norm(AINV) * EPS ),
31*> where EPS is the machine epsilon.
32*> \endverbatim
33*
34*  Arguments:
35*  ==========
36*
37*> \param[in] N
38*> \verbatim
39*>          N is INTEGER
40*>          The number of rows and columns of the matrix A.  N >= 0.
41*> \endverbatim
42*>
43*> \param[in] A
44*> \verbatim
45*>          A is REAL array, dimension (LDA,N)
46*>          The original N x N matrix A.
47*> \endverbatim
48*>
49*> \param[in] LDA
50*> \verbatim
51*>          LDA is INTEGER
52*>          The leading dimension of the array A.  LDA >= max(1,N).
53*> \endverbatim
54*>
55*> \param[in] AINV
56*> \verbatim
57*>          AINV is REAL array, dimension (LDAINV,N)
58*>          The inverse of the matrix A.
59*> \endverbatim
60*>
61*> \param[in] LDAINV
62*> \verbatim
63*>          LDAINV is INTEGER
64*>          The leading dimension of the array AINV.  LDAINV >= max(1,N).
65*> \endverbatim
66*>
67*> \param[out] WORK
68*> \verbatim
69*>          WORK is REAL array, dimension (LDWORK,N)
70*> \endverbatim
71*>
72*> \param[in] LDWORK
73*> \verbatim
74*>          LDWORK is INTEGER
75*>          The leading dimension of the array WORK.  LDWORK >= max(1,N).
76*> \endverbatim
77*>
78*> \param[out] RWORK
79*> \verbatim
80*>          RWORK is REAL array, dimension (N)
81*> \endverbatim
82*>
83*> \param[out] RCOND
84*> \verbatim
85*>          RCOND is REAL
86*>          The reciprocal of the condition number of A, computed as
87*>          ( 1/norm(A) ) / norm(AINV).
88*> \endverbatim
89*>
90*> \param[out] RESID
91*> \verbatim
92*>          RESID is REAL
93*>          norm(I - AINV*A) / ( N * norm(A) * norm(AINV) * EPS )
94*> \endverbatim
95*
96*  Authors:
97*  ========
98*
99*> \author Univ. of Tennessee
100*> \author Univ. of California Berkeley
101*> \author Univ. of Colorado Denver
102*> \author NAG Ltd.
103*
104*> \date November 2011
105*
106*> \ingroup single_lin
107*
108*  =====================================================================
109      SUBROUTINE SGET03( N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK,
110     $                   RCOND, RESID )
111*
112*  -- LAPACK test routine (version 3.4.0) --
113*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
114*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
115*     November 2011
116*
117*     .. Scalar Arguments ..
118      INTEGER            LDA, LDAINV, LDWORK, N
119      REAL               RCOND, RESID
120*     ..
121*     .. Array Arguments ..
122      REAL               A( LDA, * ), AINV( LDAINV, * ), RWORK( * ),
123     $                   WORK( LDWORK, * )
124*     ..
125*
126*  =====================================================================
127*
128*     .. Parameters ..
129      REAL               ZERO, ONE
130      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
131*     ..
132*     .. Local Scalars ..
133      INTEGER            I
134      REAL               AINVNM, ANORM, EPS
135*     ..
136*     .. External Functions ..
137      REAL               SLAMCH, SLANGE
138      EXTERNAL           SLAMCH, SLANGE
139*     ..
140*     .. External Subroutines ..
141      EXTERNAL           SGEMM
142*     ..
143*     .. Intrinsic Functions ..
144      INTRINSIC          REAL
145*     ..
146*     .. Executable Statements ..
147*
148*     Quick exit if N = 0.
149*
150      IF( N.LE.0 ) THEN
151         RCOND = ONE
152         RESID = ZERO
153         RETURN
154      END IF
155*
156*     Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0.
157*
158      EPS = SLAMCH( 'Epsilon' )
159      ANORM = SLANGE( '1', N, N, A, LDA, RWORK )
160      AINVNM = SLANGE( '1', N, N, AINV, LDAINV, RWORK )
161      IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
162         RCOND = ZERO
163         RESID = ONE / EPS
164         RETURN
165      END IF
166      RCOND = ( ONE / ANORM ) / AINVNM
167*
168*     Compute I - A * AINV
169*
170      CALL SGEMM( 'No transpose', 'No transpose', N, N, N, -ONE,
171     $     AINV, LDAINV, A, LDA, ZERO, WORK, LDWORK )
172      DO 10 I = 1, N
173         WORK( I, I ) = ONE + WORK( I, I )
174   10 CONTINUE
175*
176*     Compute norm(I - AINV*A) / (N * norm(A) * norm(AINV) * EPS)
177*
178      RESID = SLANGE( '1', N, N, WORK, LDWORK, RWORK )
179*
180      RESID = ( ( RESID*RCOND ) / EPS ) / REAL( N )
181*
182      RETURN
183*
184*     End of SGET03
185*
186      END
187