LAPACK 3.3.1 Linear Algebra PACKage

# slatm3.f

Go to the documentation of this file.
```00001       REAL             FUNCTION SLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00002      \$                 IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00003      \$                 SPARSE )
00004 *
00005 *  -- LAPACK auxiliary test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     June 2010
00008 *
00009 *     .. Scalar Arguments ..
00010 *
00011       INTEGER            I, IDIST, IGRADE, IPVTNG, ISUB, J, JSUB, KL,
00012      \$                   KU, M, N
00013       REAL               SPARSE
00014 *     ..
00015 *
00016 *     .. Array Arguments ..
00017 *
00018       INTEGER            ISEED( 4 ), IWORK( * )
00019       REAL               D( * ), DL( * ), DR( * )
00020 *     ..
00021 *
00022 *  Purpose
00023 *  =======
00024 *
00025 *     SLATM3 returns the (ISUB,JSUB) entry of a random matrix of
00026 *     dimension (M, N) described by the other paramters. (ISUB,JSUB)
00027 *     is the final position of the (I,J) entry after pivoting
00028 *     according to IPVTNG and IWORK. SLATM3 is called by the
00029 *     SLATMR routine in order to build random test matrices. No error
00030 *     checking on parameters is done, because this routine is called in
00031 *     a tight loop by SLATMR which has already checked the parameters.
00032 *
00033 *     Use of SLATM3 differs from SLATM2 in the order in which the random
00034 *     number generator is called to fill in random matrix entries.
00035 *     With SLATM2, the generator is called to fill in the pivoted matrix
00036 *     columnwise. With SLATM3, the generator is called to fill in the
00037 *     matrix columnwise, after which it is pivoted. Thus, SLATM3 can
00038 *     be used to construct random matrices which differ only in their
00039 *     order of rows and/or columns. SLATM2 is used to construct band
00040 *     matrices while avoiding calling the random number generator for
00041 *     entries outside the band (and therefore generating random numbers
00042 *     in different orders for different pivot orders).
00043 *
00044 *     The matrix whose (ISUB,JSUB) entry is returned is constructed as
00045 *     follows (this routine only computes one entry):
00046 *
00047 *       If ISUB is outside (1..M) or JSUB is outside (1..N), return zero
00048 *          (this is convenient for generating matrices in band format).
00049 *
00050 *       Generate a matrix A with random entries of distribution IDIST.
00051 *
00052 *       Set the diagonal to D.
00053 *
00054 *       Grade the matrix, if desired, from the left (by DL) and/or
00055 *          from the right (by DR or DL) as specified by IGRADE.
00056 *
00057 *       Permute, if desired, the rows and/or columns as specified by
00058 *          IPVTNG and IWORK.
00059 *
00060 *       Band the matrix to have lower bandwidth KL and upper
00061 *          bandwidth KU.
00062 *
00063 *       Set random entries to zero as specified by SPARSE.
00064 *
00065 *  Arguments
00066 *  =========
00067 *
00068 *  M        (input) INTEGER
00069 *           Number of rows of matrix. Not modified.
00070 *
00071 *  N        (input) INTEGER
00072 *           Number of columns of matrix. Not modified.
00073 *
00074 *  I        (input) INTEGER
00075 *           Row of unpivoted entry to be returned. Not modified.
00076 *
00077 *  J        (input) INTEGER
00078 *           Column of unpivoted entry to be returned. Not modified.
00079 *
00080 *  ISUB     (input/output) INTEGER
00081 *           Row of pivoted entry to be returned. Changed on exit.
00082 *
00083 *  JSUB     (input/output) INTEGER
00084 *           Column of pivoted entry to be returned. Changed on exit.
00085 *
00086 *  KL       (input) INTEGER
00087 *           Lower bandwidth. Not modified.
00088 *
00089 *  KU       (input) INTEGER
00090 *           Upper bandwidth. Not modified.
00091 *
00092 *  IDIST    (input) INTEGER
00093 *           On entry, IDIST specifies the type of distribution to be
00094 *           used to generate a random matrix .
00095 *           1 => UNIFORM( 0, 1 )
00096 *           2 => UNIFORM( -1, 1 )
00097 *           3 => NORMAL( 0, 1 )
00098 *           Not modified.
00099 *
00100 *  ISEED    (input/output) INTEGER array of dimension ( 4 )
00101 *           Seed for random number generator.
00102 *           Changed on exit.
00103 *
00104 *  D        (input) REAL array of dimension ( MIN( I , J ) )
00105 *           Diagonal entries of matrix. Not modified.
00106 *
00108 *           Specifies grading of matrix as follows:
00109 *           0  => no grading
00110 *           1  => matrix premultiplied by diag( DL )
00111 *           2  => matrix postmultiplied by diag( DR )
00112 *           3  => matrix premultiplied by diag( DL ) and
00113 *                         postmultiplied by diag( DR )
00114 *           4  => matrix premultiplied by diag( DL ) and
00115 *                         postmultiplied by inv( diag( DL ) )
00116 *           5  => matrix premultiplied by diag( DL ) and
00117 *                         postmultiplied by diag( DL )
00118 *           Not modified.
00119 *
00120 *  DL       (input) REAL array ( I or J, as appropriate )
00121 *           Left scale factors for grading matrix.  Not modified.
00122 *
00123 *  DR       (input) REAL array ( I or J, as appropriate )
00124 *           Right scale factors for grading matrix.  Not modified.
00125 *
00126 *  IPVTNG   (input) INTEGER
00127 *           On entry specifies pivoting permutations as follows:
00128 *           0 => none.
00129 *           1 => row pivoting.
00130 *           2 => column pivoting.
00131 *           3 => full pivoting, i.e., on both sides.
00132 *           Not modified.
00133 *
00134 *  IWORK    (input) INTEGER array ( I or J, as appropriate )
00135 *           This array specifies the permutation used. The
00136 *           row (or column) originally in position K is in
00137 *           position IWORK( K ) after pivoting.
00138 *           This differs from IWORK for SLATM2. Not modified.
00139 *
00140 *  SPARSE   (input) REAL between 0. and 1.
00141 *           On entry specifies the sparsity of the matrix
00142 *           if sparse matix is to be generated.
00143 *           SPARSE should lie between 0 and 1.
00144 *           A uniform ( 0, 1 ) random number x is generated and
00145 *           compared to SPARSE; if x is larger the matrix entry
00146 *           is unchanged and if x is smaller the entry is set
00147 *           to zero. Thus on the average a fraction SPARSE of the
00148 *           entries will be set to zero.
00149 *           Not modified.
00150 *
00151 *  =====================================================================
00152 *
00153 *     .. Parameters ..
00154 *
00155       REAL               ZERO
00156       PARAMETER          ( ZERO = 0.0E0 )
00157 *     ..
00158 *
00159 *     .. Local Scalars ..
00160 *
00161       REAL               TEMP
00162 *     ..
00163 *
00164 *     .. External Functions ..
00165 *
00166       REAL               SLARAN, SLARND
00167       EXTERNAL           SLARAN, SLARND
00168 *     ..
00169 *
00170 *-----------------------------------------------------------------------
00171 *
00172 *     .. Executable Statements ..
00173 *
00174 *
00175 *     Check for I and J in range
00176 *
00177       IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
00178          ISUB = I
00179          JSUB = J
00180          SLATM3 = ZERO
00181          RETURN
00182       END IF
00183 *
00184 *     Compute subscripts depending on IPVTNG
00185 *
00186       IF( IPVTNG.EQ.0 ) THEN
00187          ISUB = I
00188          JSUB = J
00189       ELSE IF( IPVTNG.EQ.1 ) THEN
00190          ISUB = IWORK( I )
00191          JSUB = J
00192       ELSE IF( IPVTNG.EQ.2 ) THEN
00193          ISUB = I
00194          JSUB = IWORK( J )
00195       ELSE IF( IPVTNG.EQ.3 ) THEN
00196          ISUB = IWORK( I )
00197          JSUB = IWORK( J )
00198       END IF
00199 *
00200 *     Check for banding
00201 *
00202       IF( JSUB.GT.ISUB+KU .OR. JSUB.LT.ISUB-KL ) THEN
00203          SLATM3 = ZERO
00204          RETURN
00205       END IF
00206 *
00207 *     Check for sparsity
00208 *
00209       IF( SPARSE.GT.ZERO ) THEN
00210          IF( SLARAN( ISEED ).LT.SPARSE ) THEN
00211             SLATM3 = ZERO
00212             RETURN
00213          END IF
00214       END IF
00215 *
00217 *
00218       IF( I.EQ.J ) THEN
00219          TEMP = D( I )
00220       ELSE
00221          TEMP = SLARND( IDIST, ISEED )
00222       END IF
00224          TEMP = TEMP*DL( I )
00225       ELSE IF( IGRADE.EQ.2 ) THEN
00226          TEMP = TEMP*DR( J )
00227       ELSE IF( IGRADE.EQ.3 ) THEN
00228          TEMP = TEMP*DL( I )*DR( J )
00229       ELSE IF( IGRADE.EQ.4 .AND. I.NE.J ) THEN
00230          TEMP = TEMP*DL( I ) / DL( J )
00231       ELSE IF( IGRADE.EQ.5 ) THEN
00232          TEMP = TEMP*DL( I )*DL( J )
00233       END IF
00234       SLATM3 = TEMP
00235       RETURN
00236 *
00237 *     End of SLATM3
00238 *
00239       END
```