 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ dlatm4()

 subroutine dlatm4 ( integer ITYPE, integer N, integer NZ1, integer NZ2, integer ISIGN, double precision AMAGN, double precision RCOND, double precision TRIANG, integer IDIST, integer, dimension( 4 ) ISEED, double precision, dimension( lda, * ) A, integer LDA )

DLATM4

Purpose:
``` DLATM4 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 DLARND.)``` [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 DOUBLE PRECISION The diagonal and subdiagonal entries will be multiplied by AMAGN.``` [in] RCOND ``` RCOND is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DLATM4 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 DOUBLE PRECISION 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.```
Date
December 2016

Definition at line 177 of file dlatm4.f.

177 *
178 * -- LAPACK test routine (version 3.7.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 * December 2016
182 *
183 * .. Scalar Arguments ..
184  INTEGER idist, isign, itype, lda, n, nz1, nz2
185  DOUBLE PRECISION amagn, rcond, triang
186 * ..
187 * .. Array Arguments ..
188  INTEGER iseed( 4 )
189  DOUBLE PRECISION a( lda, * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  DOUBLE PRECISION zero, one, two
196  parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0 )
197  DOUBLE PRECISION 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  DOUBLE PRECISION alpha, cl, cr, safmin, sl, sr, sv1, sv2, temp
204 * ..
205 * .. External Functions ..
206  DOUBLE PRECISION dlamch, dlaran, dlarnd
207  EXTERNAL dlamch, dlaran, dlarnd
208 * ..
209 * .. External Subroutines ..
210  EXTERNAL dlaset
211 * ..
212 * .. Intrinsic Functions ..
213  INTRINSIC abs, dble, exp, log, max, min, mod, sqrt
214 * ..
215 * .. Executable Statements ..
216 *
217  IF( n.LE.0 )
218  \$ RETURN
219  CALL dlaset( '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 ) = dble( 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 / dble( klen-1 ) )
309  DO 150 i = 2, klen
310  a( nz1+i, nz1+i ) = alpha**dble( 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 ) / dble( klen-1 )
321  DO 170 i = 2, klen
322  a( nz1+i, nz1+i ) = dble( 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*dlaran( 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 ) = dlarnd( 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*dble( a( jd, jd ) )
349  230 CONTINUE
350  DO 240 jd = isdb, isde
351  a( jd+1, jd ) = amagn*dble( 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( dble( a( jd, jd ) ).NE.zero ) THEN
360  IF( dlaran( iseed ).GT.half )
361  \$ a( jd, jd ) = -a( jd, jd )
362  END IF
363  250 CONTINUE
364  DO 260 jd = isdb, isde
365  IF( dble( a( jd+1, jd ) ).NE.zero ) THEN
366  IF( dlaran( 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 = dlamch( 'S' )
392  DO 290 jd = kbeg, kend - 1, 2
393  IF( dlaran( iseed ).GT.half ) THEN
394 *
395 * Rotation on left.
396 *
397  cl = two*dlaran( iseed ) - one
398  sl = two*dlaran( 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*dlaran( iseed ) - one
406  sr = two*dlaran( 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*dlarnd( 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*dlarnd( idist, iseed )
441  310 CONTINUE
442  320 CONTINUE
443  END IF
444 *
445  RETURN
446 *
447 * End of DLATM4
448 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
double precision function dlarnd(IDIST, ISEED)
DLARND
Definition: dlarnd.f:75
double precision function dlaran(ISEED)
DLARAN
Definition: dlaran.f:69
Here is the call graph for this function:
Here is the caller graph for this function: