LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine slatm4 ( integer  ITYPE,
integer  N,
integer  NZ1,
integer  NZ2,
integer  ISIGN,
real  AMAGN,
real  RCOND,
real  TRIANG,
integer  IDIST,
integer, dimension( 4 )  ISEED,
real, dimension( lda, * )  A,
integer  LDA 
)

SLATM4

Purpose: 
 SLATM4 generates basic square matrices, which may later be
 multiplied by others in order to produce test matrices.  It is
 intended mainly to be used to test the generalized eigenvalue
 routines.

 It first generates the diagonal and (possibly) subdiagonal,
 according to the value of ITYPE, NZ1, NZ2, ISIGN, AMAGN, and RCOND.
 It then fills in the upper triangle with random numbers, if TRIANG is
 non-zero.
Parameters
[in]ITYPE
          ITYPE is INTEGER
          The "type" of matrix on the diagonal and sub-diagonal.
          If ITYPE < 0, then type abs(ITYPE) is generated and then
             swapped end for end (A(I,J) := A'(N-J,N-I).)  See also
             the description of AMAGN and ISIGN.

          Special types:
          = 0:  the zero matrix.
          = 1:  the identity.
          = 2:  a transposed Jordan block.
          = 3:  If N is odd, then a k+1 x k+1 transposed Jordan block
                followed by a k x k identity block, where k=(N-1)/2.
                If N is even, then k=(N-2)/2, and a zero diagonal entry
                is tacked onto the end.

          Diagonal types.  The diagonal consists of NZ1 zeros, then
             k=N-NZ1-NZ2 nonzeros.  The subdiagonal is zero.  ITYPE
             specifies the nonzero diagonal entries as follows:
          = 4:  1, ..., k
          = 5:  1, RCOND, ..., RCOND
          = 6:  1, ..., 1, RCOND
          = 7:  1, a, a^2, ..., a^(k-1)=RCOND
          = 8:  1, 1-d, 1-2*d, ..., 1-(k-1)*d=RCOND
          = 9:  random numbers chosen from (RCOND,1)
          = 10: random numbers with distribution IDIST (see SLARND.)
[in]N
          N is INTEGER
          The order of the matrix.
[in]NZ1
          NZ1 is INTEGER
          If abs(ITYPE) > 3, then the first NZ1 diagonal entries will
          be zero.
[in]NZ2
          NZ2 is INTEGER
          If abs(ITYPE) > 3, then the last NZ2 diagonal entries will
          be zero.
[in]ISIGN
          ISIGN is INTEGER
          = 0: The sign of the diagonal and subdiagonal entries will
               be left unchanged.
          = 1: The diagonal and subdiagonal entries will have their
               sign changed at random.
          = 2: If ITYPE is 2 or 3, then the same as ISIGN=1.
               Otherwise, with probability 0.5, odd-even pairs of
               diagonal entries A(2*j-1,2*j-1), A(2*j,2*j) will be
               converted to a 2x2 block by pre- and post-multiplying
               by distinct random orthogonal rotations.  The remaining
               diagonal entries will have their sign changed at random.
[in]AMAGN
          AMAGN is REAL
          The diagonal and subdiagonal entries will be multiplied by
          AMAGN.
[in]RCOND
          RCOND is REAL
          If abs(ITYPE) > 4, then the smallest diagonal entry will be
          entry will be RCOND.  RCOND must be between 0 and 1.
[in]TRIANG
          TRIANG is REAL
          The entries above the diagonal will be random numbers with
          magnitude bounded by TRIANG (i.e., random numbers multiplied
          by TRIANG.)
[in]IDIST
          IDIST is INTEGER
          Specifies the type of distribution to be used to generate a
          random matrix.
          = 1:  UNIFORM( 0, 1 )
          = 2:  UNIFORM( -1, 1 )
          = 3:  NORMAL ( 0, 1 )
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry ISEED specifies the seed of the random number
          generator.  The values of ISEED are changed on exit, and can
          be used in the next call to SLATM4 to continue the same
          random number sequence.
          Note: ISEED(4) should be odd, for the random number generator
          used at present.
[out]A
          A is REAL array, dimension (LDA, N)
          Array to be computed.
[in]LDA
          LDA is INTEGER
          Leading dimension of A.  Must be at least 1 and at least N.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 177 of file slatm4.f.

177 *
178 * -- LAPACK test routine (version 3.4.0) --
179 * -- LAPACK is a software package provided by Univ. of Tennessee, --
180 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
181 * November 2011
182 *
183 * .. Scalar Arguments ..
184  INTEGER idist, isign, itype, lda, n, nz1, nz2
185  REAL amagn, rcond, triang
186 * ..
187 * .. Array Arguments ..
188  INTEGER iseed( 4 )
189  REAL a( lda, * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL zero, one, two
196  parameter ( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
197  REAL half
198  parameter ( half = one / two )
199 * ..
200 * .. Local Scalars ..
201  INTEGER i, ioff, isdb, isde, jc, jd, jr, k, kbeg, kend,
202  $ klen
203  REAL alpha, cl, cr, safmin, sl, sr, sv1, sv2, temp
204 * ..
205 * .. External Functions ..
206  REAL slamch, slaran, slarnd
207  EXTERNAL slamch, slaran, slarnd
208 * ..
209 * .. External Subroutines ..
210  EXTERNAL slaset
211 * ..
212 * .. Intrinsic Functions ..
213  INTRINSIC abs, exp, log, max, min, mod, REAL, sqrt
214 * ..
215 * .. Executable Statements ..
216 *
217  IF( n.LE.0 )
218  $ RETURN
219  CALL slaset( 'Full', n, n, zero, zero, a, lda )
220 *
221 * Insure a correct ISEED
222 *
223  IF( mod( iseed( 4 ), 2 ).NE.1 )
224  $ iseed( 4 ) = iseed( 4 ) + 1
225 *
226 * Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2,
227 * and RCOND
228 *
229  IF( itype.NE.0 ) THEN
230  IF( abs( itype ).GE.4 ) THEN
231  kbeg = max( 1, min( n, nz1+1 ) )
232  kend = max( kbeg, min( n, n-nz2 ) )
233  klen = kend + 1 - kbeg
234  ELSE
235  kbeg = 1
236  kend = n
237  klen = n
238  END IF
239  isdb = 1
240  isde = 0
241  GO TO ( 10, 30, 50, 80, 100, 120, 140, 160,
242  $ 180, 200 )abs( itype )
243 *
244 * abs(ITYPE) = 1: Identity
245 *
246  10 CONTINUE
247  DO 20 jd = 1, n
248  a( jd, jd ) = one
249  20 CONTINUE
250  GO TO 220
251 *
252 * abs(ITYPE) = 2: Transposed Jordan block
253 *
254  30 CONTINUE
255  DO 40 jd = 1, n - 1
256  a( jd+1, jd ) = one
257  40 CONTINUE
258  isdb = 1
259  isde = n - 1
260  GO TO 220
261 *
262 * abs(ITYPE) = 3: Transposed Jordan block, followed by the
263 * identity.
264 *
265  50 CONTINUE
266  k = ( n-1 ) / 2
267  DO 60 jd = 1, k
268  a( jd+1, jd ) = one
269  60 CONTINUE
270  isdb = 1
271  isde = k
272  DO 70 jd = k + 2, 2*k + 1
273  a( jd, jd ) = one
274  70 CONTINUE
275  GO TO 220
276 *
277 * abs(ITYPE) = 4: 1,...,k
278 *
279  80 CONTINUE
280  DO 90 jd = kbeg, kend
281  a( jd, jd ) = REAL( jd-nz1 )
282  90 CONTINUE
283  GO TO 220
284 *
285 * abs(ITYPE) = 5: One large D value:
286 *
287  100 CONTINUE
288  DO 110 jd = kbeg + 1, kend
289  a( jd, jd ) = rcond
290  110 CONTINUE
291  a( kbeg, kbeg ) = one
292  GO TO 220
293 *
294 * abs(ITYPE) = 6: One small D value:
295 *
296  120 CONTINUE
297  DO 130 jd = kbeg, kend - 1
298  a( jd, jd ) = one
299  130 CONTINUE
300  a( kend, kend ) = rcond
301  GO TO 220
302 *
303 * abs(ITYPE) = 7: Exponentially distributed D values:
304 *
305  140 CONTINUE
306  a( kbeg, kbeg ) = one
307  IF( klen.GT.1 ) THEN
308  alpha = rcond**( one / REAL( KLEN-1 ) )
309  DO 150 i = 2, klen
310  a( nz1+i, nz1+i ) = alpha**REAL( i-1 )
311  150 CONTINUE
312  END IF
313  GO TO 220
314 *
315 * abs(ITYPE) = 8: Arithmetically distributed D values:
316 *
317  160 CONTINUE
318  a( kbeg, kbeg ) = one
319  IF( klen.GT.1 ) THEN
320  alpha = ( one-rcond ) / REAL( klen-1 )
321  DO 170 i = 2, klen
322  a( nz1+i, nz1+i ) = REAL( klen-i )*alpha + rcond
323  170 CONTINUE
324  END IF
325  GO TO 220
326 *
327 * abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1):
328 *
329  180 CONTINUE
330  alpha = log( rcond )
331  DO 190 jd = kbeg, kend
332  a( jd, jd ) = exp( alpha*slaran( iseed ) )
333  190 CONTINUE
334  GO TO 220
335 *
336 * abs(ITYPE) = 10: Randomly distributed D values from DIST
337 *
338  200 CONTINUE
339  DO 210 jd = kbeg, kend
340  a( jd, jd ) = slarnd( idist, iseed )
341  210 CONTINUE
342 *
343  220 CONTINUE
344 *
345 * Scale by AMAGN
346 *
347  DO 230 jd = kbeg, kend
348  a( jd, jd ) = amagn*REAL( A( JD, JD ) )
349  230 CONTINUE
350  DO 240 jd = isdb, isde
351  a( jd+1, jd ) = amagn*REAL( A( JD+1, JD ) )
352  240 CONTINUE
353 *
354 * If ISIGN = 1 or 2, assign random signs to diagonal and
355 * subdiagonal
356 *
357  IF( isign.GT.0 ) THEN
358  DO 250 jd = kbeg, kend
359  IF( REAL( A( JD, JD ) ).NE.zero ) then
360  IF( slaran( iseed ).GT.half )
361  $ a( jd, jd ) = -a( jd, jd )
362  END IF
363  250 CONTINUE
364  DO 260 jd = isdb, isde
365  IF( REAL( A( JD+1, JD ) ).NE.zero ) then
366  IF( slaran( iseed ).GT.half )
367  $ a( jd+1, jd ) = -a( jd+1, jd )
368  END IF
369  260 CONTINUE
370  END IF
371 *
372 * Reverse if ITYPE < 0
373 *
374  IF( itype.LT.0 ) THEN
375  DO 270 jd = kbeg, ( kbeg+kend-1 ) / 2
376  temp = a( jd, jd )
377  a( jd, jd ) = a( kbeg+kend-jd, kbeg+kend-jd )
378  a( kbeg+kend-jd, kbeg+kend-jd ) = temp
379  270 CONTINUE
380  DO 280 jd = 1, ( n-1 ) / 2
381  temp = a( jd+1, jd )
382  a( jd+1, jd ) = a( n+1-jd, n-jd )
383  a( n+1-jd, n-jd ) = temp
384  280 CONTINUE
385  END IF
386 *
387 * If ISIGN = 2, and no subdiagonals already, then apply
388 * random rotations to make 2x2 blocks.
389 *
390  IF( isign.EQ.2 .AND. itype.NE.2 .AND. itype.NE.3 ) THEN
391  safmin = slamch( 'S' )
392  DO 290 jd = kbeg, kend - 1, 2
393  IF( slaran( iseed ).GT.half ) THEN
394 *
395 * Rotation on left.
396 *
397  cl = two*slaran( iseed ) - one
398  sl = two*slaran( iseed ) - one
399  temp = one / max( safmin, sqrt( cl**2+sl**2 ) )
400  cl = cl*temp
401  sl = sl*temp
402 *
403 * Rotation on right.
404 *
405  cr = two*slaran( iseed ) - one
406  sr = two*slaran( iseed ) - one
407  temp = one / max( safmin, sqrt( cr**2+sr**2 ) )
408  cr = cr*temp
409  sr = sr*temp
410 *
411 * Apply
412 *
413  sv1 = a( jd, jd )
414  sv2 = a( jd+1, jd+1 )
415  a( jd, jd ) = cl*cr*sv1 + sl*sr*sv2
416  a( jd+1, jd ) = -sl*cr*sv1 + cl*sr*sv2
417  a( jd, jd+1 ) = -cl*sr*sv1 + sl*cr*sv2
418  a( jd+1, jd+1 ) = sl*sr*sv1 + cl*cr*sv2
419  END IF
420  290 CONTINUE
421  END IF
422 *
423  END IF
424 *
425 * Fill in upper triangle (except for 2x2 blocks)
426 *
427  IF( triang.NE.zero ) THEN
428  IF( isign.NE.2 .OR. itype.EQ.2 .OR. itype.EQ.3 ) THEN
429  ioff = 1
430  ELSE
431  ioff = 2
432  DO 300 jr = 1, n - 1
433  IF( a( jr+1, jr ).EQ.zero )
434  $ a( jr, jr+1 ) = triang*slarnd( idist, iseed )
435  300 CONTINUE
436  END IF
437 *
438  DO 320 jc = 2, n
439  DO 310 jr = 1, jc - ioff
440  a( jr, jc ) = triang*slarnd( idist, iseed )
441  310 CONTINUE
442  320 CONTINUE
443  END IF
444 *
445  RETURN
446 *
447 * End of SLATM4
448 *
slaset
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112
slarnd
real function slarnd(IDIST, ISEED)
SLARND
Definition: slarnd.f:75
slaran
real function slaran(ISEED)
SLARAN
Definition: slaran.f:69
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: