LAPACK: TESTING/EIG/slatb9.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
00002      $                   KLB, KUB, ANORM, BNORM, MODEA, MODEB,
00003      $                   CNDNMA, CNDNMB, DISTA, DISTB )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       CHARACTER          DISTA, DISTB, TYPE
00011       CHARACTER*3        PATH
00012       INTEGER            IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N
00013       REAL               ANORM, BNORM, CNDNMA, CNDNMB
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  SLATB9 sets parameters for the matrix generator based on the type of
00020 *  matrix to be generated.
00021 *
00022 *  Arguments
00023 *  =========
00024 *
00025 *  PATH    (input) CHARACTER*3
00026 *          The LAPACK path name.
00027 *
00028 *  IMAT    (input) INTEGER
00029 *          An integer key describing which matrix to generate for this
00030 *          path.
00031 *
00032 *  M       (input) INTEGER
00033 *          The number of rows in the matrix to be generated.
00034 *
00035 *  N       (input) INTEGER
00036 *          The number of columns in the matrix to be generated.
00037 *
00038 *  TYPE    (output) CHARACTER*1
00039 *          The type of the matrix to be generated:
00040 *          = 'S':  symmetric matrix;
00041 *          = 'P':  symmetric positive (semi)definite matrix;
00042 *          = 'N':  nonsymmetric matrix.
00043 *
00044 *  KL      (output) INTEGER
00045 *          The lower band width of the matrix to be generated.
00046 *
00047 *  KU      (output) INTEGER
00048 *          The upper band width of the matrix to be generated.
00049 *
00050 *  ANORM   (output) REAL
00051 *          The desired norm of the matrix to be generated.  The diagonal
00052 *          matrix of singular values or eigenvalues is scaled by this
00053 *          value.
00054 *
00055 *  MODE    (output) INTEGER
00056 *          A key indicating how to choose the vector of eigenvalues.
00057 *
00058 *  CNDNUM  (output) REAL
00059 *          The desired condition number.
00060 *
00061 *  DIST    (output) CHARACTER*1
00062 *          The type of distribution to be used by the random number
00063 *          generator.
00064 *
00065 *  =====================================================================
00066 *
00067 *     .. Parameters ..
00068       REAL               SHRINK, TENTH
00069       PARAMETER          ( SHRINK = 0.25E0, TENTH = 0.1E+0 )
00070       REAL               ONE, TEN
00071       PARAMETER          ( ONE = 1.0E+0, TEN = 1.0E+1 )
00072 *     ..
00073 *     .. Local Scalars ..
00074       LOGICAL            FIRST
00075       REAL               BADC1, BADC2, EPS, LARGE, SMALL
00076 *     ..
00077 *     .. External Functions ..
00078       LOGICAL            LSAMEN
00079       REAL               SLAMCH
00080       EXTERNAL           LSAMEN, SLAMCH
00081 *     ..
00082 *     .. Intrinsic Functions ..
00083       INTRINSIC          MAX, SQRT
00084 *     ..
00085 *     .. External Subroutines ..
00086       EXTERNAL           SLABAD
00087 *     ..
00088 *     .. Save statement ..
00089       SAVE               EPS, SMALL, LARGE, BADC1, BADC2, FIRST
00090 *     ..
00091 *     .. Data statements ..
00092       DATA               FIRST / .TRUE. /
00093 *     ..
00094 *     .. Executable Statements ..
00095 *
00096 *     Set some constants for use in the subroutine.
00097 *
00098       IF( FIRST ) THEN
00099          FIRST = .FALSE.
00100          EPS = SLAMCH( 'Precision' )
00101          BADC2 = TENTH / EPS
00102          BADC1 = SQRT( BADC2 )
00103          SMALL = SLAMCH( 'Safe minimum' )
00104          LARGE = ONE / SMALL
00105 *
00106 *        If it looks like we're on a Cray, take the square root of
00107 *        SMALL and LARGE to avoid overflow and underflow problems.
00108 *
00109          CALL SLABAD( SMALL, LARGE )
00110          SMALL = SHRINK*( SMALL / EPS )
00111          LARGE = ONE / SMALL
00112       END IF
00113 *
00114 *     Set some parameters we don't plan to change.
00115 *
00116       TYPE = 'N'
00117       DISTA = 'S'
00118       DISTB = 'S'
00119       MODEA = 3
00120       MODEB = 4
00121 *
00122 *     Set the lower and upper bandwidths.
00123 *
00124       IF( LSAMEN( 3, PATH, 'GRQ') .OR. LSAMEN( 3, PATH, 'LSE') .OR.
00125      $    LSAMEN( 3, PATH, 'GSV') )THEN
00126 *
00127 *        A: M by N, B: P by N
00128 *
00129          IF( IMAT.EQ.1 ) THEN
00130 *
00131 *           A: diagonal, B: upper triangular
00132 *
00133             KLA = 0
00134             KUA = 0
00135             KLB = 0
00136             KUB = MAX( N-1,0 )
00137 *
00138          ELSE IF( IMAT.EQ.2 ) THEN
00139 *
00140 *           A: upper triangular, B: upper triangular
00141 *
00142             KLA = 0
00143             KUA = MAX( N-1, 0 )
00144             KLB = 0
00145             KUB = MAX( N-1, 0 )
00146 *
00147          ELSE IF( IMAT.EQ.3 ) THEN
00148 *
00149 *           A: lower triangular, B: upper triangular
00150 *
00151             KLA = MAX( M-1, 0 )
00152             KUA = 0
00153             KLB = 0
00154             KUB = MAX( N-1, 0 )
00155 *
00156          ELSE
00157 *
00158 *           A: general dense, B: general dense
00159 *       
00160             KLA = MAX( M-1, 0 )
00161             KUA = MAX( N-1, 0 )
00162             KLB = MAX( P-1, 0 )
00163             KUB = MAX( N-1, 0 )
00164 *
00165          END IF
00166 *
00167       ELSE IF( LSAMEN( 3, PATH, 'GQR' ) .OR.
00168      $         LSAMEN( 3, PATH, 'GLM') )THEN
00169 *
00170 *        A: N by M, B: N by P
00171 *
00172          IF( IMAT.EQ.1 ) THEN
00173 *
00174 *           A: diagonal, B: lower triangular
00175 *
00176             KLA = 0
00177             KUA = 0
00178             KLB = MAX( N-1,0 )
00179             KUB = 0
00180          ELSE IF( IMAT.EQ.2 ) THEN
00181 *
00182 *           A: lower triangular, B: diagonal
00183 *
00184             KLA = MAX( N-1, 0 )
00185             KUA = 0
00186             KLB = 0
00187             KUB = 0
00188 *
00189          ELSE IF( IMAT.EQ.3 ) THEN
00190 *
00191 *           A: lower triangular, B: upper triangular
00192 *
00193             KLA = MAX( N-1, 0 )
00194             KUA = 0
00195             KLB = 0
00196             KUB = MAX( P-1, 0 )
00197 *
00198          ELSE
00199 *
00200 *           A: general dense, B: general dense
00201 *
00202             KLA = MAX( N-1, 0 )
00203             KUA = MAX( M-1, 0 )
00204             KLB = MAX( N-1, 0 )
00205             KUB = MAX( P-1, 0 )
00206          END IF
00207 *
00208       END IF
00209 *
00210 *     Set the condition number and norm.
00211 *
00212       CNDNMA = TEN*TEN
00213       CNDNMB = TEN
00214       IF( LSAMEN( 3, PATH, 'GQR') .OR. LSAMEN( 3, PATH, 'GRQ') .OR.
00215      $    LSAMEN( 3, PATH, 'GSV') )THEN
00216          IF( IMAT.EQ.5 ) THEN
00217             CNDNMA = BADC1
00218             CNDNMB = BADC1
00219          ELSE IF( IMAT.EQ.6 ) THEN
00220             CNDNMA = BADC2
00221             CNDNMB = BADC2
00222          ELSE IF( IMAT.EQ.7 ) THEN
00223             CNDNMA = BADC1
00224             CNDNMB = BADC2
00225          ELSE IF( IMAT.EQ.8 ) THEN
00226             CNDNMA = BADC2
00227             CNDNMB = BADC1
00228          END IF
00229       END IF
00230 *
00231       ANORM = TEN
00232       BNORM = TEN*TEN*TEN
00233       IF( LSAMEN( 3, PATH, 'GQR') .OR. LSAMEN( 3, PATH, 'GRQ') )THEN
00234          IF( IMAT.EQ.7 ) THEN
00235             ANORM = SMALL
00236             BNORM = LARGE
00237          ELSE IF( IMAT.EQ.8 ) THEN
00238             ANORM = LARGE
00239             BNORM = SMALL
00240          END IF
00241       END IF
00242 *
00243       IF( N.LE.1 )THEN
00244          CNDNMA = ONE
00245          CNDNMB = ONE
00246       END IF
00247 *
00248       RETURN
00249 *
00250 *     End of SLATB9
00251 *
00252       END