LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zchkgk.f
Go to the documentation of this file.
00001 *> \brief \b ZCHKGK
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE ZCHKGK( NIN, NOUT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            NIN, NOUT
00015 *       ..
00016 *  
00017 *
00018 *> \par Purpose:
00019 *  =============
00020 *>
00021 *> \verbatim
00022 *>
00023 *> ZCHKGK tests ZGGBAK, a routine for backward balancing  of
00024 *> a matrix pair (A, B).
00025 *> \endverbatim
00026 *
00027 *  Arguments:
00028 *  ==========
00029 *
00030 *> \param[in] NIN
00031 *> \verbatim
00032 *>          NIN is INTEGER
00033 *>          The logical unit number for input.  NIN > 0.
00034 *> \endverbatim
00035 *>
00036 *> \param[in] NOUT
00037 *> \verbatim
00038 *>          NOUT is INTEGER
00039 *>          The logical unit number for output.  NOUT > 0.
00040 *> \endverbatim
00041 *
00042 *  Authors:
00043 *  ========
00044 *
00045 *> \author Univ. of Tennessee 
00046 *> \author Univ. of California Berkeley 
00047 *> \author Univ. of Colorado Denver 
00048 *> \author NAG Ltd. 
00049 *
00050 *> \date November 2011
00051 *
00052 *> \ingroup complex16_eig
00053 *
00054 *  =====================================================================
00055       SUBROUTINE ZCHKGK( NIN, NOUT )
00056 *
00057 *  -- LAPACK test routine (version 3.4.0) --
00058 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00059 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00060 *     November 2011
00061 *
00062 *     .. Scalar Arguments ..
00063       INTEGER            NIN, NOUT
00064 *     ..
00065 *
00066 *  =====================================================================
00067 *
00068 *     .. Parameters ..
00069       INTEGER            LDA, LDB, LDVL, LDVR
00070       PARAMETER          ( LDA = 50, LDB = 50, LDVL = 50, LDVR = 50 )
00071       INTEGER            LDE, LDF, LDWORK, LRWORK
00072       PARAMETER          ( LDE = 50, LDF = 50, LDWORK = 50,
00073      $                   LRWORK = 6*50 )
00074       DOUBLE PRECISION   ZERO
00075       PARAMETER          ( ZERO = 0.0D+0 )
00076       COMPLEX*16         CZERO, CONE
00077       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
00078      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
00079 *     ..
00080 *     .. Local Scalars ..
00081       INTEGER            I, IHI, ILO, INFO, J, KNT, M, N, NINFO
00082       DOUBLE PRECISION   ANORM, BNORM, EPS, RMAX, VMAX
00083       COMPLEX*16         CDUM
00084 *     ..
00085 *     .. Local Arrays ..
00086       INTEGER            LMAX( 4 )
00087       DOUBLE PRECISION   LSCALE( LDA ), RSCALE( LDA ), RWORK( LRWORK )
00088       COMPLEX*16         A( LDA, LDA ), AF( LDA, LDA ), B( LDB, LDB ),
00089      $                   BF( LDB, LDB ), E( LDE, LDE ), F( LDF, LDF ),
00090      $                   VL( LDVL, LDVL ), VLF( LDVL, LDVL ),
00091      $                   VR( LDVR, LDVR ), VRF( LDVR, LDVR ),
00092      $                   WORK( LDWORK, LDWORK )
00093 *     ..
00094 *     .. External Functions ..
00095       DOUBLE PRECISION   DLAMCH, ZLANGE
00096       EXTERNAL           DLAMCH, ZLANGE
00097 *     ..
00098 *     .. External Subroutines ..
00099       EXTERNAL           ZGEMM, ZGGBAK, ZGGBAL, ZLACPY
00100 *     ..
00101 *     .. Intrinsic Functions ..
00102       INTRINSIC          ABS, DBLE, DIMAG, MAX
00103 *     ..
00104 *     .. Statement Functions ..
00105       DOUBLE PRECISION   CABS1
00106 *     ..
00107 *     .. Statement Function definitions ..
00108       CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
00109 *     ..
00110 *     .. Executable Statements ..
00111 *
00112       LMAX( 1 ) = 0
00113       LMAX( 2 ) = 0
00114       LMAX( 3 ) = 0
00115       LMAX( 4 ) = 0
00116       NINFO = 0
00117       KNT = 0
00118       RMAX = ZERO
00119 *
00120       EPS = DLAMCH( 'Precision' )
00121 *
00122    10 CONTINUE
00123       READ( NIN, FMT = * )N, M
00124       IF( N.EQ.0 )
00125      $   GO TO 100
00126 *
00127       DO 20 I = 1, N
00128          READ( NIN, FMT = * )( A( I, J ), J = 1, N )
00129    20 CONTINUE
00130 *
00131       DO 30 I = 1, N
00132          READ( NIN, FMT = * )( B( I, J ), J = 1, N )
00133    30 CONTINUE
00134 *
00135       DO 40 I = 1, N
00136          READ( NIN, FMT = * )( VL( I, J ), J = 1, M )
00137    40 CONTINUE
00138 *
00139       DO 50 I = 1, N
00140          READ( NIN, FMT = * )( VR( I, J ), J = 1, M )
00141    50 CONTINUE
00142 *
00143       KNT = KNT + 1
00144 *
00145       ANORM = ZLANGE( 'M', N, N, A, LDA, RWORK )
00146       BNORM = ZLANGE( 'M', N, N, B, LDB, RWORK )
00147 *
00148       CALL ZLACPY( 'FULL', N, N, A, LDA, AF, LDA )
00149       CALL ZLACPY( 'FULL', N, N, B, LDB, BF, LDB )
00150 *
00151       CALL ZGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
00152      $             RWORK, INFO )
00153       IF( INFO.NE.0 ) THEN
00154          NINFO = NINFO + 1
00155          LMAX( 1 ) = KNT
00156       END IF
00157 *
00158       CALL ZLACPY( 'FULL', N, M, VL, LDVL, VLF, LDVL )
00159       CALL ZLACPY( 'FULL', N, M, VR, LDVR, VRF, LDVR )
00160 *
00161       CALL ZGGBAK( 'B', 'L', N, ILO, IHI, LSCALE, RSCALE, M, VL, LDVL,
00162      $             INFO )
00163       IF( INFO.NE.0 ) THEN
00164          NINFO = NINFO + 1
00165          LMAX( 2 ) = KNT
00166       END IF
00167 *
00168       CALL ZGGBAK( 'B', 'R', N, ILO, IHI, LSCALE, RSCALE, M, VR, LDVR,
00169      $             INFO )
00170       IF( INFO.NE.0 ) THEN
00171          NINFO = NINFO + 1
00172          LMAX( 3 ) = KNT
00173       END IF
00174 *
00175 *     Test of ZGGBAK
00176 *
00177 *     Check tilde(VL)'*A*tilde(VR) - VL'*tilde(A)*VR
00178 *     where tilde(A) denotes the transformed matrix.
00179 *
00180       CALL ZGEMM( 'N', 'N', N, M, N, CONE, AF, LDA, VR, LDVR, CZERO,
00181      $            WORK, LDWORK )
00182       CALL ZGEMM( 'C', 'N', M, M, N, CONE, VL, LDVL, WORK, LDWORK,
00183      $            CZERO, E, LDE )
00184 *
00185       CALL ZGEMM( 'N', 'N', N, M, N, CONE, A, LDA, VRF, LDVR, CZERO,
00186      $            WORK, LDWORK )
00187       CALL ZGEMM( 'C', 'N', M, M, N, CONE, VLF, LDVL, WORK, LDWORK,
00188      $            CZERO, F, LDF )
00189 *
00190       VMAX = ZERO
00191       DO 70 J = 1, M
00192          DO 60 I = 1, M
00193             VMAX = MAX( VMAX, CABS1( E( I, J )-F( I, J ) ) )
00194    60    CONTINUE
00195    70 CONTINUE
00196       VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
00197       IF( VMAX.GT.RMAX ) THEN
00198          LMAX( 4 ) = KNT
00199          RMAX = VMAX
00200       END IF
00201 *
00202 *     Check tilde(VL)'*B*tilde(VR) - VL'*tilde(B)*VR
00203 *
00204       CALL ZGEMM( 'N', 'N', N, M, N, CONE, BF, LDB, VR, LDVR, CZERO,
00205      $            WORK, LDWORK )
00206       CALL ZGEMM( 'C', 'N', M, M, N, CONE, VL, LDVL, WORK, LDWORK,
00207      $            CZERO, E, LDE )
00208 *
00209       CALL ZGEMM( 'n', 'n', N, M, N, CONE, B, LDB, VRF, LDVR, CZERO,
00210      $            WORK, LDWORK )
00211       CALL ZGEMM( 'C', 'N', M, M, N, CONE, VLF, LDVL, WORK, LDWORK,
00212      $            CZERO, F, LDF )
00213 *
00214       VMAX = ZERO
00215       DO 90 J = 1, M
00216          DO 80 I = 1, M
00217             VMAX = MAX( VMAX, CABS1( E( I, J )-F( I, J ) ) )
00218    80    CONTINUE
00219    90 CONTINUE
00220       VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
00221       IF( VMAX.GT.RMAX ) THEN
00222          LMAX( 4 ) = KNT
00223          RMAX = VMAX
00224       END IF
00225 *
00226       GO TO 10
00227 *
00228   100 CONTINUE
00229 *
00230       WRITE( NOUT, FMT = 9999 )
00231  9999 FORMAT( 1X, '.. test output of ZGGBAK .. ' )
00232 *
00233       WRITE( NOUT, FMT = 9998 )RMAX
00234  9998 FORMAT( ' value of largest test error                  =', D12.3 )
00235       WRITE( NOUT, FMT = 9997 )LMAX( 1 )
00236  9997 FORMAT( ' example number where ZGGBAL info is not 0    =', I4 )
00237       WRITE( NOUT, FMT = 9996 )LMAX( 2 )
00238  9996 FORMAT( ' example number where ZGGBAK(L) info is not 0 =', I4 )
00239       WRITE( NOUT, FMT = 9995 )LMAX( 3 )
00240  9995 FORMAT( ' example number where ZGGBAK(R) info is not 0 =', I4 )
00241       WRITE( NOUT, FMT = 9994 )LMAX( 4 )
00242  9994 FORMAT( ' example number having largest error          =', I4 )
00243       WRITE( NOUT, FMT = 9992 )NINFO
00244  9992 FORMAT( ' number of examples where info is not 0       =', I4 )
00245       WRITE( NOUT, FMT = 9991 )KNT
00246  9991 FORMAT( ' total number of examples tested              =', I4 )
00247 *
00248       RETURN
00249 *
00250 *     End of ZCHKGK
00251 *
00252       END
 All Files Functions