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