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