1       DOUBLE PRECISION FUNCTION DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
  2      $                 IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
  3      $                 SPARSE )
  4 *
  5 *  -- LAPACK auxiliary test routine (version 3.1) --
  6 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  7 *     June 2010
  8 *
  9 *     .. Scalar Arguments ..
 10 *
 11       INTEGER            I, IDIST, IGRADE, IPVTNG, ISUB, J, JSUB, KL,
 12      $                   KU, M, N
 13       DOUBLE PRECISION   SPARSE
 14 *     ..
 15 *
 16 *     .. Array Arguments ..
 17 *
 18       INTEGER            ISEED( 4 ), IWORK( * )
 19       DOUBLE PRECISION   D( * ), DL( * ), DR( * )
 20 *     ..
 21 *
 22 *  Purpose
 23 *  =======
 24 *
 25 *     DLATM3 returns the (ISUB,JSUB) entry of a random matrix of
 26 *     dimension (M, N) described by the other paramters. (ISUB,JSUB)
 27 *     is the final position of the (I,J) entry after pivoting
 28 *     according to IPVTNG and IWORK. DLATM3 is called by the
 29 *     DLATMR routine in order to build random test matrices. No error
 30 *     checking on parameters is done, because this routine is called in
 31 *     a tight loop by DLATMR which has already checked the parameters.
 32 *
 33 *     Use of DLATM3 differs from SLATM2 in the order in which the random
 34 *     number generator is called to fill in random matrix entries.
 35 *     With DLATM2, the generator is called to fill in the pivoted matrix
 36 *     columnwise. With DLATM3, the generator is called to fill in the
 37 *     matrix columnwise, after which it is pivoted. Thus, DLATM3 can
 38 *     be used to construct random matrices which differ only in their
 39 *     order of rows and/or columns. DLATM2 is used to construct band
 40 *     matrices while avoiding calling the random number generator for
 41 *     entries outside the band (and therefore generating random numbers
 42 *     in different orders for different pivot orders).
 43 *
 44 *     The matrix whose (ISUB,JSUB) entry is returned is constructed as
 45 *     follows (this routine only computes one entry):
 46 *
 47 *       If ISUB is outside (1..M) or JSUB is outside (1..N), return zero
 48 *          (this is convenient for generating matrices in band format).
 49 *
 50 *       Generate a matrix A with random entries of distribution IDIST.
 51 *
 52 *       Set the diagonal to D.
 53 *
 54 *       Grade the matrix, if desired, from the left (by DL) and/or
 55 *          from the right (by DR or DL) as specified by IGRADE.
 56 *
 57 *       Permute, if desired, the rows and/or columns as specified by
 58 *          IPVTNG and IWORK.
 59 *
 60 *       Band the matrix to have lower bandwidth KL and upper
 61 *          bandwidth KU.
 62 *
 63 *       Set random entries to zero as specified by SPARSE.
 64 *
 65 *  Arguments
 66 *  =========
 67 *
 68 *  M        (input) INTEGER
 69 *           Number of rows of matrix. Not modified.
 70 *
 71 *  N        (input) INTEGER
 72 *           Number of columns of matrix. Not modified.
 73 *
 74 *  I       (input) INTEGER
 75 *           Row of unpivoted entry to be returned. Not modified.
 76 *
 77 *  J        (input) INTEGER
 78 *           Column of unpivoted entry to be returned. Not modified.
 79 *
 80 *  ISUB    (input/output) INTEGER
 81 *           Row of pivoted entry to be returned. Changed on exit.
 82 *
 83 *  JSUB     (input/output) INTEGER
 84 *           Column of pivoted entry to be returned. Changed on exit.
 85 *
 86 *  KL       (input) INTEGER
 87 *           Lower bandwidth. Not modified.
 88 *
 89 *  KU       (input) INTEGER
 90 *           Upper bandwidth. Not modified.
 91 *
 92 *  IDIST    (input) INTEGER
 93 *           On entry, IDIST specifies the type of distribution to be
 94 *           used to generate a random matrix .
 95 *           1 => UNIFORM( 0, 1 )
 96 *           2 => UNIFORM( -1, 1 )
 97 *           3 => NORMAL( 0, 1 )
 98 *           Not modified.
 99 *
100 *  ISEED    (input/output) INTEGER array of dimension ( 4 )
101 *           Seed for random number generator.
102 *           Changed on exit.
103 *
104 *  D        (input) DOUBLE PRECISION array of dimension ( MIN( I , J ) )
105 *           Diagonal entries of matrix. Not modified.
106 *
107 *  IGRADE   (input) INTEGER
108 *           Specifies grading of matrix as follows:
109 *           0  => no grading
110 *           1  => matrix premultiplied by diag( DL )
111 *           2  => matrix postmultiplied by diag( DR )
112 *           3  => matrix premultiplied by diag( DL ) and
113 *                         postmultiplied by diag( DR )
114 *           4  => matrix premultiplied by diag( DL ) and
115 *                         postmultiplied by inv( diag( DL ) )
116 *           5  => matrix premultiplied by diag( DL ) and
117 *                         postmultiplied by diag( DL )
118 *           Not modified.
119 *
120 *  DL       (input) DOUBLE PRECISION array ( I or J, as appropriate )
121 *           Left scale factors for grading matrix.  Not modified.
122 *
123 *  DR       (input) DOUBLE PRECISION array ( I or J, as appropriate )
124 *           Right scale factors for grading matrix.  Not modified.
125 *
126 *  IPVTNG   (input) INTEGER
127 *           On entry specifies pivoting permutations as follows:
128 *           0 => none.
129 *           1 => row pivoting.
130 *           2 => column pivoting.
131 *           3 => full pivoting, i.e., on both sides.
132 *           Not modified.
133 *
134 *  IWORK    (input) INTEGER array ( I or J, as appropriate )
135 *           This array specifies the permutation used. The
136 *           row (or column) originally in position K is in
137 *           position IWORK( K ) after pivoting.
138 *           This differs from IWORK for DLATM2. Not modified.
139 *
140 *  SPARSE   (input) DOUBLE PRECISION between 0. and 1.
141 *           On entry specifies the sparsity of the matrix
142 *           if sparse matix is to be generated.
143 *           SPARSE should lie between 0 and 1.
144 *           A uniform ( 0, 1 ) random number x is generated and
145 *           compared to SPARSE; if x is larger the matrix entry
146 *           is unchanged and if x is smaller the entry is set
147 *           to zero. Thus on the average a fraction SPARSE of the
148 *           entries will be set to zero.
149 *           Not modified.
150 *
151 *  =====================================================================
152 *
153 *     .. Parameters ..
154 *
155       DOUBLE PRECISION   ZERO
156       PARAMETER          ( ZERO = 0.0D0 )
157 *     ..
158 *
159 *     .. Local Scalars ..
160 *
161       DOUBLE PRECISION   TEMP
162 *     ..
163 *
164 *     .. External Functions ..
165 *
166       DOUBLE PRECISION   DLARAN, DLARND
167       EXTERNAL           DLARAN, DLARND
168 *     ..
169 *
170 *-----------------------------------------------------------------------
171 *
172 *     .. Executable Statements ..
173 *
174 *
175 *     Check for I and J in range
176 *
177       IF( I.LT.1 .OR. I.GT..OR. J.LT.1 .OR. J.GT.N ) THEN
178          ISUB = I
179          JSUB = J
180          DLATM3 = ZERO
181          RETURN
182       END IF
183 *
184 *     Compute subscripts depending on IPVTNG
185 *
186       IF( IPVTNG.EQ.0 ) THEN
187          ISUB = I
188          JSUB = J
189       ELSE IF( IPVTNG.EQ.1 ) THEN
190          ISUB = IWORK( I )
191          JSUB = J
192       ELSE IF( IPVTNG.EQ.2 ) THEN
193          ISUB = I
194          JSUB = IWORK( J )
195       ELSE IF( IPVTNG.EQ.3 ) THEN
196          ISUB = IWORK( I )
197          JSUB = IWORK( J )
198       END IF
199 *
200 *     Check for banding
201 *
202       IF( JSUB.GT.ISUB+KU .OR. JSUB.LT.ISUB-KL ) THEN
203          DLATM3 = ZERO
204          RETURN
205       END IF
206 *
207 *     Check for sparsity
208 *
209       IF( SPARSE.GT.ZERO ) THEN
210          IF( DLARAN( ISEED ).LT.SPARSE ) THEN
211             DLATM3 = ZERO
212             RETURN
213          END IF
214       END IF
215 *
216 *     Compute entry and grade it according to IGRADE
217 *
218       IF( I.EQ.J ) THEN
219          TEMP = D( I )
220       ELSE
221          TEMP = DLARND( IDIST, ISEED )
222       END IF
223       IF( IGRADE.EQ.1 ) THEN
224          TEMP = TEMP*DL( I )
225       ELSE IF( IGRADE.EQ.2 ) THEN
226          TEMP = TEMP*DR( J )
227       ELSE IF( IGRADE.EQ.3 ) THEN
228          TEMP = TEMP*DL( I )*DR( J )
229       ELSE IF( IGRADE.EQ.4 .AND. I.NE.J ) THEN
230          TEMP = TEMP*DL( I ) / DL( J )
231       ELSE IF( IGRADE.EQ.5 ) THEN
232          TEMP = TEMP*DL( I )*DL( J )
233       END IF
234       DLATM3 = TEMP
235       RETURN
236 *
237 *     End of DLATM3
238 *
239       END