MAGMA  1.2.0 MatrixAlgebraonGPUandMulticoreArchitectures
dlatm3.f
Go to the documentation of this file.
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 *
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.m .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 *
217 *
218  IF( i.EQ.j ) THEN
219  temp = d( i )
220  ELSE
221  temp = dlarnd( idist, iseed )
222  END IF
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