3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
11 * SUBROUTINE DCHKGK( NIN, NOUT )
13 * .. Scalar Arguments ..
23 *> DCHKGK tests DGGBAK, a routine for backward balancing of
24 *> a matrix pair (A, B).
33 *> The logical unit number for input. NIN > 0.
39 *> The logical unit number for output. NOUT > 0.
45 *> \author Univ. of Tennessee
46 *> \author Univ. of California Berkeley
47 *> \author Univ. of Colorado Denver
50 *> \date November 2011
52 *> \ingroup double_eig
54 * =====================================================================
55 SUBROUTINE DCHKGK( NIN, NOUT )
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
62 * .. Scalar Arguments ..
66 * =====================================================================
69 INTEGER LDA, LDB, LDVL, LDVR
70 PARAMETER ( LDA = 50, LDB = 50, LDVL = 50, LDVR = 50 )
71 INTEGER LDE, LDF, LDWORK
72 PARAMETER ( LDE = 50, LDF = 50, LDWORK = 50 )
73 DOUBLE PRECISION ZERO, ONE
74 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
77 INTEGER I, IHI, ILO, INFO, J, KNT, M, N, NINFO
78 DOUBLE PRECISION ANORM, BNORM, EPS, RMAX, VMAX
82 DOUBLE PRECISION A( LDA, LDA ), AF( LDA, LDA ), B( LDB, LDB ),
83 $ BF( LDB, LDB ), E( LDE, LDE ), F( LDF, LDF ),
84 $ LSCALE( LDA ), RSCALE( LDA ), VL( LDVL, LDVL ),
85 $ VLF( LDVL, LDVL ), VR( LDVR, LDVR ),
86 $ VRF( LDVR, LDVR ), WORK( LDWORK, LDWORK )
88 * .. External Functions ..
89 DOUBLE PRECISION DLAMCH, DLANGE
90 EXTERNAL DLAMCH, DLANGE
92 * .. External Subroutines ..
93 EXTERNAL DGEMM, DGGBAK, DGGBAL, DLACPY
95 * .. Intrinsic Functions ..
98 * .. Executable Statements ..
110 EPS = DLAMCH( 'Precision' )
113 READ( NIN, FMT = * )N, M
118 READ( NIN, FMT = * )( A( I, J ), J = 1, N )
122 READ( NIN, FMT = * )( B( I, J ), J = 1, N )
126 READ( NIN, FMT = * )( VL( I, J ), J = 1, M )
130 READ( NIN, FMT = * )( VR( I, J ), J = 1, M )
135 ANORM = DLANGE( 'M', N, N, A, LDA, WORK )
136 BNORM = DLANGE( 'M', N, N, B, LDB, WORK )
138 CALL DLACPY( 'FULL', N, N, A, LDA, AF, LDA )
139 CALL DLACPY( 'FULL', N, N, B, LDB, BF, LDB )
141 CALL DGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
148 CALL DLACPY( 'FULL', N, M, VL, LDVL, VLF, LDVL )
149 CALL DLACPY( 'FULL', N, M, VR, LDVR, VRF, LDVR )
151 CALL DGGBAK( 'B', 'L', N, ILO, IHI, LSCALE, RSCALE, M, VL, LDVL,
158 CALL DGGBAK( 'B', 'R', N, ILO, IHI, LSCALE, RSCALE, M, VR, LDVR,
167 * Check tilde(VL)'*A*tilde(VR) - VL'*tilde(A)*VR
168 * where tilde(A) denotes the transformed matrix.
170 CALL DGEMM( 'N', 'N', N, M, N, ONE, AF, LDA, VR, LDVR, ZERO, WORK,
172 CALL DGEMM( 'T', 'N', M, M, N, ONE, VL, LDVL, WORK, LDWORK, ZERO,
175 CALL DGEMM( 'N', 'N', N, M, N, ONE, A, LDA, VRF, LDVR, ZERO, WORK,
177 CALL DGEMM( 'T', 'N', M, M, N, ONE, VLF, LDVL, WORK, LDWORK, ZERO,
183 VMAX = MAX( VMAX, ABS( E( I, J )-F( I, J ) ) )
186 VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
187 IF( VMAX.GT.RMAX ) THEN
192 * Check tilde(VL)'*B*tilde(VR) - VL'*tilde(B)*VR
194 CALL DGEMM( 'N', 'N', N, M, N, ONE, BF, LDB, VR, LDVR, ZERO, WORK,
196 CALL DGEMM( 'T', 'N', M, M, N, ONE, VL, LDVL, WORK, LDWORK, ZERO,
199 CALL DGEMM( 'N', 'N', N, M, N, ONE, B, LDB, VRF, LDVR, ZERO, WORK,
201 CALL DGEMM( 'T', 'N', M, M, N, ONE, VLF, LDVL, WORK, LDWORK, ZERO,
207 VMAX = MAX( VMAX, ABS( E( I, J )-F( I, J ) ) )
210 VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
211 IF( VMAX.GT.RMAX ) THEN
220 WRITE( NOUT, FMT = 9999 )
221 9999 FORMAT( 1X, '.. test output of DGGBAK .. ' )
223 WRITE( NOUT, FMT = 9998 )RMAX
224 9998 FORMAT( ' value of largest test error =', D12.3 )
225 WRITE( NOUT, FMT = 9997 )LMAX( 1 )
226 9997 FORMAT( ' example number where DGGBAL info is not 0 =', I4 )
227 WRITE( NOUT, FMT = 9996 )LMAX( 2 )
228 9996 FORMAT( ' example number where DGGBAK(L) info is not 0 =', I4 )
229 WRITE( NOUT, FMT = 9995 )LMAX( 3 )
230 9995 FORMAT( ' example number where DGGBAK(R) info is not 0 =', I4 )
231 WRITE( NOUT, FMT = 9994 )LMAX( 4 )
232 9994 FORMAT( ' example number having largest error =', I4 )
233 WRITE( NOUT, FMT = 9993 )NINFO
234 9993 FORMAT( ' number of examples where info is not 0 =', I4 )
235 WRITE( NOUT, FMT = 9992 )KNT
236 9992 FORMAT( ' total number of examples tested =', I4 )