![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZCHKBK 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 ZCHKBK( NIN, NOUT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER NIN, NOUT 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> ZCHKBK tests ZGEBAK, a routine for backward transformation of 00024 *> the computed right or left eigenvectors if the orginal matrix 00025 *> was preprocessed by balance subroutine ZGEBAL. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] NIN 00032 *> \verbatim 00033 *> NIN is INTEGER 00034 *> The logical unit number for input. NIN > 0. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NOUT 00038 *> \verbatim 00039 *> NOUT is INTEGER 00040 *> The logical unit number for output. NOUT > 0. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup complex16_eig 00054 * 00055 * ===================================================================== 00056 SUBROUTINE ZCHKBK( NIN, NOUT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 INTEGER NIN, NOUT 00065 * .. 00066 * 00067 * ====================================================================== 00068 * 00069 * .. Parameters .. 00070 INTEGER LDE 00071 PARAMETER ( LDE = 20 ) 00072 DOUBLE PRECISION ZERO 00073 PARAMETER ( ZERO = 0.0D0 ) 00074 * .. 00075 * .. Local Scalars .. 00076 INTEGER I, IHI, ILO, INFO, J, KNT, N, NINFO 00077 DOUBLE PRECISION EPS, RMAX, SAFMIN, VMAX, X 00078 COMPLEX*16 CDUM 00079 * .. 00080 * .. Local Arrays .. 00081 INTEGER LMAX( 2 ) 00082 DOUBLE PRECISION SCALE( LDE ) 00083 COMPLEX*16 E( LDE, LDE ), EIN( LDE, LDE ) 00084 * .. 00085 * .. External Functions .. 00086 DOUBLE PRECISION DLAMCH 00087 EXTERNAL DLAMCH 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL ZGEBAK 00091 * .. 00092 * .. Intrinsic Functions .. 00093 INTRINSIC ABS, DBLE, DIMAG, MAX 00094 * .. 00095 * .. Statement Functions .. 00096 DOUBLE PRECISION CABS1 00097 * .. 00098 * .. Statement Function definitions .. 00099 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) 00100 * .. 00101 * .. Executable Statements .. 00102 * 00103 LMAX( 1 ) = 0 00104 LMAX( 2 ) = 0 00105 NINFO = 0 00106 KNT = 0 00107 RMAX = ZERO 00108 EPS = DLAMCH( 'E' ) 00109 SAFMIN = DLAMCH( 'S' ) 00110 * 00111 10 CONTINUE 00112 * 00113 READ( NIN, FMT = * )N, ILO, IHI 00114 IF( N.EQ.0 ) 00115 $ GO TO 60 00116 * 00117 READ( NIN, FMT = * )( SCALE( I ), I = 1, N ) 00118 DO 20 I = 1, N 00119 READ( NIN, FMT = * )( E( I, J ), J = 1, N ) 00120 20 CONTINUE 00121 * 00122 DO 30 I = 1, N 00123 READ( NIN, FMT = * )( EIN( I, J ), J = 1, N ) 00124 30 CONTINUE 00125 * 00126 KNT = KNT + 1 00127 CALL ZGEBAK( 'B', 'R', N, ILO, IHI, SCALE, N, E, LDE, INFO ) 00128 * 00129 IF( INFO.NE.0 ) THEN 00130 NINFO = NINFO + 1 00131 LMAX( 1 ) = KNT 00132 END IF 00133 * 00134 VMAX = ZERO 00135 DO 50 I = 1, N 00136 DO 40 J = 1, N 00137 X = CABS1( E( I, J )-EIN( I, J ) ) / EPS 00138 IF( CABS1( E( I, J ) ).GT.SAFMIN ) 00139 $ X = X / CABS1( E( I, J ) ) 00140 VMAX = MAX( VMAX, X ) 00141 40 CONTINUE 00142 50 CONTINUE 00143 * 00144 IF( VMAX.GT.RMAX ) THEN 00145 LMAX( 2 ) = KNT 00146 RMAX = VMAX 00147 END IF 00148 * 00149 GO TO 10 00150 * 00151 60 CONTINUE 00152 * 00153 WRITE( NOUT, FMT = 9999 ) 00154 9999 FORMAT( 1X, '.. test output of ZGEBAK .. ' ) 00155 * 00156 WRITE( NOUT, FMT = 9998 )RMAX 00157 9998 FORMAT( 1X, 'value of largest test error = ', D12.3 ) 00158 WRITE( NOUT, FMT = 9997 )LMAX( 1 ) 00159 9997 FORMAT( 1X, 'example number where info is not zero = ', I4 ) 00160 WRITE( NOUT, FMT = 9996 )LMAX( 2 ) 00161 9996 FORMAT( 1X, 'example number having largest error = ', I4 ) 00162 WRITE( NOUT, FMT = 9995 )NINFO 00163 9995 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 ) 00164 WRITE( NOUT, FMT = 9994 )KNT 00165 9994 FORMAT( 1X, 'total number of examples tested = ', I4 ) 00166 * 00167 RETURN 00168 * 00169 * End of ZCHKBK 00170 * 00171 END