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