1*> \brief \b SLATM2
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       REAL             FUNCTION SLATM2( M, N, I, J, KL, KU, IDIST,
12*                        ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
13*
14*       .. Scalar Arguments ..
15*
16*       INTEGER            I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
17*       REAL               SPARSE
18*       ..
19*
20*       .. Array Arguments ..
21*
22*       INTEGER            ISEED( 4 ), IWORK( * )
23*       REAL               D( * ), DL( * ), DR( * )
24*       ..
25*
26*
27*> \par Purpose:
28*  =============
29*>
30*> \verbatim
31*>
32*>    SLATM2 returns the (I,J) entry of a random matrix of dimension
33*>    (M, N) described by the other parameters. It is called by the
34*>    SLATMR routine in order to build random test matrices. No error
35*>    checking on parameters is done, because this routine is called in
36*>    a tight loop by SLATMR which has already checked the parameters.
37*>
38*>    Use of SLATM2 differs from SLATM3 in the order in which the random
39*>    number generator is called to fill in random matrix entries.
40*>    With SLATM2, the generator is called to fill in the pivoted matrix
41*>    columnwise. With SLATM3, the generator is called to fill in the
42*>    matrix columnwise, after which it is pivoted. Thus, SLATM3 can
43*>    be used to construct random matrices which differ only in their
44*>    order of rows and/or columns. SLATM2 is used to construct band
45*>    matrices while avoiding calling the random number generator for
46*>    entries outside the band (and therefore generating random numbers
47*>
48*>    The matrix whose (I,J) entry is returned is constructed as
49*>    follows (this routine only computes one entry):
50*>
51*>      If I is outside (1..M) or J is outside (1..N), return zero
52*>         (this is convenient for generating matrices in band format).
53*>
54*>      Generate a matrix A with random entries of distribution IDIST.
55*>
56*>      Set the diagonal to D.
57*>
58*>      Grade the matrix, if desired, from the left (by DL) and/or
59*>         from the right (by DR or DL) as specified by IGRADE.
60*>
61*>      Permute, if desired, the rows and/or columns as specified by
62*>         IPVTNG and IWORK.
63*>
64*>      Band the matrix to have lower bandwidth KL and upper
65*>         bandwidth KU.
66*>
67*>      Set random entries to zero as specified by SPARSE.
68*> \endverbatim
69*
70*  Arguments:
71*  ==========
72*
73*> \param[in] M
74*> \verbatim
75*>          M is INTEGER
76*>           Number of rows of matrix. Not modified.
77*> \endverbatim
78*>
79*> \param[in] N
80*> \verbatim
81*>          N is INTEGER
82*>           Number of columns of matrix. Not modified.
83*> \endverbatim
84*>
85*> \param[in] I
86*> \verbatim
87*>          I is INTEGER
88*>           Row of entry to be returned. Not modified.
89*> \endverbatim
90*>
91*> \param[in] J
92*> \verbatim
93*>          J is INTEGER
94*>           Column of entry to be returned. Not modified.
95*> \endverbatim
96*>
97*> \param[in] KL
98*> \verbatim
99*>          KL is INTEGER
100*>           Lower bandwidth. Not modified.
101*> \endverbatim
102*>
103*> \param[in] KU
104*> \verbatim
105*>          KU is INTEGER
106*>           Upper bandwidth. Not modified.
107*> \endverbatim
108*>
109*> \param[in] IDIST
110*> \verbatim
111*>          IDIST is INTEGER
112*>           On entry, IDIST specifies the type of distribution to be
113*>           used to generate a random matrix .
114*>           1 => UNIFORM( 0, 1 )
115*>           2 => UNIFORM( -1, 1 )
116*>           3 => NORMAL( 0, 1 )
117*>           Not modified.
118*> \endverbatim
119*>
120*> \param[in,out] ISEED
121*> \verbatim
122*>          ISEED is INTEGER array of dimension ( 4 )
123*>           Seed for random number generator.
124*>           Changed on exit.
125*> \endverbatim
126*>
127*> \param[in] D
128*> \verbatim
129*>          D is REAL array of dimension ( MIN( I , J ) )
130*>           Diagonal entries of matrix. Not modified.
131*> \endverbatim
132*>
133*> \param[in] IGRADE
134*> \verbatim
135*>          IGRADE is INTEGER
136*>           Specifies grading of matrix as follows:
137*>           0  => no grading
138*>           1  => matrix premultiplied by diag( DL )
139*>           2  => matrix postmultiplied by diag( DR )
140*>           3  => matrix premultiplied by diag( DL ) and
141*>                         postmultiplied by diag( DR )
142*>           4  => matrix premultiplied by diag( DL ) and
143*>                         postmultiplied by inv( diag( DL ) )
144*>           5  => matrix premultiplied by diag( DL ) and
145*>                         postmultiplied by diag( DL )
146*>           Not modified.
147*> \endverbatim
148*>
149*> \param[in] DL
150*> \verbatim
151*>          DL is REAL array ( I or J, as appropriate )
152*>           Left scale factors for grading matrix.  Not modified.
153*> \endverbatim
154*>
155*> \param[in] DR
156*> \verbatim
157*>          DR is REAL array ( I or J, as appropriate )
158*>           Right scale factors for grading matrix.  Not modified.
159*> \endverbatim
160*>
161*> \param[in] IPVTNG
162*> \verbatim
163*>          IPVTNG is INTEGER
164*>           On entry specifies pivoting permutations as follows:
165*>           0 => none.
166*>           1 => row pivoting.
167*>           2 => column pivoting.
168*>           3 => full pivoting, i.e., on both sides.
169*>           Not modified.
170*> \endverbatim
171*>
172*> \param[out] IWORK
173*> \verbatim
174*>          IWORK is INTEGER array ( I or J, as appropriate )
175*>           This array specifies the permutation used. The
176*>           row (or column) in position K was originally in
177*>           position IWORK( K ).
178*>           This differs from IWORK for SLATM3. Not modified.
179*> \endverbatim
180*>
181*> \param[in] SPARSE
182*> \verbatim
183*>          SPARSE is REAL between 0. and 1.
184*>           On entry specifies the sparsity of the matrix
185*>           if sparse matrix is to be generated.
186*>           SPARSE should lie between 0 and 1.
187*>           A uniform ( 0, 1 ) random number x is generated and
188*>           compared to SPARSE; if x is larger the matrix entry
189*>           is unchanged and if x is smaller the entry is set
190*>           to zero. Thus on the average a fraction SPARSE of the
191*>           entries will be set to zero.
192*>           Not modified.
193*> \endverbatim
194*
195*  Authors:
196*  ========
197*
198*> \author Univ. of Tennessee
199*> \author Univ. of California Berkeley
200*> \author Univ. of Colorado Denver
201*> \author NAG Ltd.
202*
203*> \ingroup real_matgen
204*
205*  =====================================================================
206      REAL             FUNCTION SLATM2( M, N, I, J, KL, KU, IDIST,
207     $                 ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
208*
209*  -- LAPACK auxiliary routine --
210*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
211*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
212*
213*     .. Scalar Arguments ..
214*
215      INTEGER            I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
216      REAL               SPARSE
217*     ..
218*
219*     .. Array Arguments ..
220*
221      INTEGER            ISEED( 4 ), IWORK( * )
222      REAL               D( * ), DL( * ), DR( * )
223*     ..
224*
225*  =====================================================================
226*
227*     .. Parameters ..
228*
229      REAL               ZERO
230      PARAMETER          ( ZERO = 0.0E0 )
231*     ..
232*
233*     .. Local Scalars ..
234*
235      INTEGER            ISUB, JSUB
236      REAL               TEMP
237*     ..
238*
239*     .. External Functions ..
240*
241      REAL               SLARAN, SLARND
242      EXTERNAL           SLARAN, SLARND
243*     ..
244*
245*-----------------------------------------------------------------------
246*
247*     .. Executable Statements ..
248*
249*
250*     Check for I and J in range
251*
252      IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
253         SLATM2 = ZERO
254         RETURN
255      END IF
256*
257*     Check for banding
258*
259      IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
260         SLATM2 = ZERO
261         RETURN
262      END IF
263*
264*     Check for sparsity
265*
266      IF( SPARSE.GT.ZERO ) THEN
267         IF( SLARAN( ISEED ).LT.SPARSE ) THEN
268            SLATM2 = ZERO
269            RETURN
270         END IF
271      END IF
272*
273*     Compute subscripts depending on IPVTNG
274*
275      IF( IPVTNG.EQ.0 ) THEN
276         ISUB = I
277         JSUB = J
278      ELSE IF( IPVTNG.EQ.1 ) THEN
279         ISUB = IWORK( I )
280         JSUB = J
281      ELSE IF( IPVTNG.EQ.2 ) THEN
282         ISUB = I
283         JSUB = IWORK( J )
284      ELSE IF( IPVTNG.EQ.3 ) THEN
285         ISUB = IWORK( I )
286         JSUB = IWORK( J )
287      END IF
288*
289*     Compute entry and grade it according to IGRADE
290*
291      IF( ISUB.EQ.JSUB ) THEN
292         TEMP = D( ISUB )
293      ELSE
294         TEMP = SLARND( IDIST, ISEED )
295      END IF
296      IF( IGRADE.EQ.1 ) THEN
297         TEMP = TEMP*DL( ISUB )
298      ELSE IF( IGRADE.EQ.2 ) THEN
299         TEMP = TEMP*DR( JSUB )
300      ELSE IF( IGRADE.EQ.3 ) THEN
301         TEMP = TEMP*DL( ISUB )*DR( JSUB )
302      ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
303         TEMP = TEMP*DL( ISUB ) / DL( JSUB )
304      ELSE IF( IGRADE.EQ.5 ) THEN
305         TEMP = TEMP*DL( ISUB )*DL( JSUB )
306      END IF
307      SLATM2 = TEMP
308      RETURN
309*
310*     End of SLATM2
311*
312      END
313