1*> \brief \b DSGT01
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 DSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
12*                          WORK, RESULT )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          UPLO
16*       INTEGER            ITYPE, LDA, LDB, LDZ, M, N
17*       ..
18*       .. Array Arguments ..
19*       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), D( * ), RESULT( * ),
20*      $                   WORK( * ), Z( LDZ, * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> DDGT01 checks a decomposition of the form
30*>
31*>    A Z   =  B Z D or
32*>    A B Z =  Z D or
33*>    B A Z =  Z D
34*>
35*> where A is a symmetric matrix, B is
36*> symmetric positive definite, Z is orthogonal, and D is diagonal.
37*>
38*> One of the following test ratios is computed:
39*>
40*> ITYPE = 1:  RESULT(1) = | A Z - B Z D | / ( |A| |Z| n ulp )
41*>
42*> ITYPE = 2:  RESULT(1) = | A B Z - Z D | / ( |A| |Z| n ulp )
43*>
44*> ITYPE = 3:  RESULT(1) = | B A Z - Z D | / ( |A| |Z| n ulp )
45*> \endverbatim
46*
47*  Arguments:
48*  ==========
49*
50*> \param[in] ITYPE
51*> \verbatim
52*>          ITYPE is INTEGER
53*>          The form of the symmetric generalized eigenproblem.
54*>          = 1:  A*z = (lambda)*B*z
55*>          = 2:  A*B*z = (lambda)*z
56*>          = 3:  B*A*z = (lambda)*z
57*> \endverbatim
58*>
59*> \param[in] UPLO
60*> \verbatim
61*>          UPLO is CHARACTER*1
62*>          Specifies whether the upper or lower triangular part of the
63*>          symmetric matrices A and B is stored.
64*>          = 'U':  Upper triangular
65*>          = 'L':  Lower triangular
66*> \endverbatim
67*>
68*> \param[in] N
69*> \verbatim
70*>          N is INTEGER
71*>          The order of the matrix A.  N >= 0.
72*> \endverbatim
73*>
74*> \param[in] M
75*> \verbatim
76*>          M is INTEGER
77*>          The number of eigenvalues found.  0 <= M <= N.
78*> \endverbatim
79*>
80*> \param[in] A
81*> \verbatim
82*>          A is DOUBLE PRECISION array, dimension (LDA, N)
83*>          The original symmetric matrix A.
84*> \endverbatim
85*>
86*> \param[in] LDA
87*> \verbatim
88*>          LDA is INTEGER
89*>          The leading dimension of the array A.  LDA >= max(1,N).
90*> \endverbatim
91*>
92*> \param[in] B
93*> \verbatim
94*>          B is DOUBLE PRECISION array, dimension (LDB, N)
95*>          The original symmetric positive definite matrix B.
96*> \endverbatim
97*>
98*> \param[in] LDB
99*> \verbatim
100*>          LDB is INTEGER
101*>          The leading dimension of the array B.  LDB >= max(1,N).
102*> \endverbatim
103*>
104*> \param[in] Z
105*> \verbatim
106*>          Z is DOUBLE PRECISION array, dimension (LDZ, M)
107*>          The computed eigenvectors of the generalized eigenproblem.
108*> \endverbatim
109*>
110*> \param[in] LDZ
111*> \verbatim
112*>          LDZ is INTEGER
113*>          The leading dimension of the array Z.  LDZ >= max(1,N).
114*> \endverbatim
115*>
116*> \param[in] D
117*> \verbatim
118*>          D is DOUBLE PRECISION array, dimension (M)
119*>          The computed eigenvalues of the generalized eigenproblem.
120*> \endverbatim
121*>
122*> \param[out] WORK
123*> \verbatim
124*>          WORK is DOUBLE PRECISION array, dimension (N*N)
125*> \endverbatim
126*>
127*> \param[out] RESULT
128*> \verbatim
129*>          RESULT is DOUBLE PRECISION array, dimension (1)
130*>          The test ratio as described above.
131*> \endverbatim
132*
133*  Authors:
134*  ========
135*
136*> \author Univ. of Tennessee
137*> \author Univ. of California Berkeley
138*> \author Univ. of Colorado Denver
139*> \author NAG Ltd.
140*
141*> \ingroup double_eig
142*
143*  =====================================================================
144      SUBROUTINE DSGT01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
145     $                   WORK, RESULT )
146*
147*  -- LAPACK test routine --
148*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
149*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
150*
151*     .. Scalar Arguments ..
152      CHARACTER          UPLO
153      INTEGER            ITYPE, LDA, LDB, LDZ, M, N
154*     ..
155*     .. Array Arguments ..
156      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), D( * ), RESULT( * ),
157     $                   WORK( * ), Z( LDZ, * )
158*     ..
159*
160*  =====================================================================
161*
162*     .. Parameters ..
163      DOUBLE PRECISION   ZERO, ONE
164      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
165*     ..
166*     .. Local Scalars ..
167      INTEGER            I
168      DOUBLE PRECISION   ANORM, ULP
169*     ..
170*     .. External Functions ..
171      DOUBLE PRECISION   DLAMCH, DLANGE, DLANSY
172      EXTERNAL           DLAMCH, DLANGE, DLANSY
173*     ..
174*     .. External Subroutines ..
175      EXTERNAL           DSCAL, DSYMM
176*     ..
177*     .. Executable Statements ..
178*
179      RESULT( 1 ) = ZERO
180      IF( N.LE.0 )
181     $   RETURN
182*
183      ULP = DLAMCH( 'Epsilon' )
184*
185*     Compute product of 1-norms of A and Z.
186*
187      ANORM = DLANSY( '1', UPLO, N, A, LDA, WORK )*
188     $        DLANGE( '1', N, M, Z, LDZ, WORK )
189      IF( ANORM.EQ.ZERO )
190     $   ANORM = ONE
191*
192      IF( ITYPE.EQ.1 ) THEN
193*
194*        Norm of AZ - BZD
195*
196         CALL DSYMM( 'Left', UPLO, N, M, ONE, A, LDA, Z, LDZ, ZERO,
197     $               WORK, N )
198         DO 10 I = 1, M
199            CALL DSCAL( N, D( I ), Z( 1, I ), 1 )
200   10    CONTINUE
201         CALL DSYMM( 'Left', UPLO, N, M, ONE, B, LDB, Z, LDZ, -ONE,
202     $               WORK, N )
203*
204         RESULT( 1 ) = ( DLANGE( '1', N, M, WORK, N, WORK ) / ANORM ) /
205     $                 ( N*ULP )
206*
207      ELSE IF( ITYPE.EQ.2 ) THEN
208*
209*        Norm of ABZ - ZD
210*
211         CALL DSYMM( 'Left', UPLO, N, M, ONE, B, LDB, Z, LDZ, ZERO,
212     $               WORK, N )
213         DO 20 I = 1, M
214            CALL DSCAL( N, D( I ), Z( 1, I ), 1 )
215   20    CONTINUE
216         CALL DSYMM( 'Left', UPLO, N, M, ONE, A, LDA, WORK, N, -ONE, Z,
217     $               LDZ )
218*
219         RESULT( 1 ) = ( DLANGE( '1', N, M, Z, LDZ, WORK ) / ANORM ) /
220     $                 ( N*ULP )
221*
222      ELSE IF( ITYPE.EQ.3 ) THEN
223*
224*        Norm of BAZ - ZD
225*
226         CALL DSYMM( 'Left', UPLO, N, M, ONE, A, LDA, Z, LDZ, ZERO,
227     $               WORK, N )
228         DO 30 I = 1, M
229            CALL DSCAL( N, D( I ), Z( 1, I ), 1 )
230   30    CONTINUE
231         CALL DSYMM( 'Left', UPLO, N, M, ONE, B, LDB, WORK, N, -ONE, Z,
232     $               LDZ )
233*
234         RESULT( 1 ) = ( DLANGE( '1', N, M, Z, LDZ, WORK ) / ANORM ) /
235     $                 ( N*ULP )
236      END IF
237*
238      RETURN
239*
240*     End of DSGT01
241*
242      END
243