clatm4()

subroutine clatm4	(	integer	ITYPE,
		integer	N,
		integer	NZ1,
		integer	NZ2,
		logical	RSIGN,
		real	AMAGN,
		real	RCOND,
		real	TRIANG,
		integer	IDIST,
		integer, dimension( 4 )	ISEED,
		complex, dimension( lda, * )	A,
		integer	LDA
	)

CLATM4

Purpose:

 CLATM4 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, RSIGN, 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 RSIGN. 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 CLARND.)
[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]	RSIGN	RSIGN is LOGICAL = .TRUE.: The diagonal and subdiagonal entries will be multiplied by random numbers of magnitude 1. = .FALSE.: The diagonal and subdiagonal entries will be left as they are (usually non-negative real.)
[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 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 On entry, DIST specifies the type of distribution to be used to generate a random matrix . = 1: real and imaginary parts each UNIFORM( 0, 1 ) = 2: real and imaginary parts each UNIFORM( -1, 1 ) = 3: real and imaginary parts each NORMAL( 0, 1 ) = 4: complex number uniform in DISK( 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 CLATM4 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 COMPLEX 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

December 2016

Definition at line 173 of file clatm4.f.

*
*  -- LAPACK test routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      LOGICAL            RSIGN
      INTEGER            IDIST, ITYPE, LDA, N, NZ1, NZ2
      REAL               AMAGN, RCOND, TRIANG
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 )
      COMPLEX            A( LDA, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0e+0, one = 1.0e+0 )
      COMPLEX            CZERO, CONE
      parameter( czero = ( 0.0e+0, 0.0e+0 ),
     $                   cone = ( 1.0e+0, 0.0e+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            I, ISDB, ISDE, JC, JD, JR, K, KBEG, KEND, KLEN
      REAL               ALPHA
      COMPLEX            CTEMP
*     ..
*     .. External Functions ..
      REAL               SLARAN
      COMPLEX            CLARND
      EXTERNAL           slaran, clarnd
*     ..
*     .. External Subroutines ..
      EXTERNAL           claset
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, cmplx, exp, log, max, min, mod, real
*     ..
*     .. Executable Statements ..
*
      IF( n.LE.0 )
     $   RETURN
      CALL claset( 'Full', n, n, czero, czero, a, lda )
*
*     Insure a correct ISEED
*
      IF( mod( iseed( 4 ), 2 ).NE.1 )
     $   iseed( 4 ) = iseed( 4 ) + 1
*
*     Compute diagonal and subdiagonal according to ITYPE, NZ1, NZ2,
*     and RCOND
*
      IF( itype.NE.0 ) THEN
         IF( abs( itype ).GE.4 ) THEN
            kbeg = max( 1, min( n, nz1+1 ) )
            kend = max( kbeg, min( n, n-nz2 ) )
            klen = kend + 1 - kbeg
         ELSE
            kbeg = 1
            kend = n
            klen = n
         END IF
         isdb = 1
         isde = 0
         GO TO ( 10, 30, 50, 80, 100, 120, 140, 160,
     $           180, 200 )abs( itype )
*
*        abs(ITYPE) = 1: Identity
*
   10    CONTINUE
         DO 20 jd = 1, n
            a( jd, jd ) = cone
   20    CONTINUE
         GO TO 220
*
*        abs(ITYPE) = 2: Transposed Jordan block
*
   30    CONTINUE
         DO 40 jd = 1, n - 1
            a( jd+1, jd ) = cone
   40    CONTINUE
         isdb = 1
         isde = n - 1
         GO TO 220
*
*        abs(ITYPE) = 3: Transposed Jordan block, followed by the
*                        identity.
*
   50    CONTINUE
         k = ( n-1 ) / 2
         DO 60 jd = 1, k
            a( jd+1, jd ) = cone
   60    CONTINUE
         isdb = 1
         isde = k
         DO 70 jd = k + 2, 2*k + 1
            a( jd, jd ) = cone
   70    CONTINUE
         GO TO 220
*
*        abs(ITYPE) = 4: 1,...,k
*
   80    CONTINUE
         DO 90 jd = kbeg, kend
            a( jd, jd ) = cmplx( jd-nz1 )
   90    CONTINUE
         GO TO 220
*
*        abs(ITYPE) = 5: One large D value:
*
  100    CONTINUE
         DO 110 jd = kbeg + 1, kend
            a( jd, jd ) = cmplx( rcond )
  110    CONTINUE
         a( kbeg, kbeg ) = cone
         GO TO 220
*
*        abs(ITYPE) = 6: One small D value:
*
  120    CONTINUE
         DO 130 jd = kbeg, kend - 1
            a( jd, jd ) = cone
  130    CONTINUE
         a( kend, kend ) = cmplx( rcond )
         GO TO 220
*
*        abs(ITYPE) = 7: Exponentially distributed D values:
*
  140    CONTINUE
         a( kbeg, kbeg ) = cone
         IF( klen.GT.1 ) THEN
            alpha = rcond**( one / real( klen-1 ) )
            DO 150 i = 2, klen
               a( nz1+i, nz1+i ) = cmplx( alpha**real( i-1 ) )
  150       CONTINUE
         END IF
         GO TO 220
*
*        abs(ITYPE) = 8: Arithmetically distributed D values:
*
  160    CONTINUE
         a( kbeg, kbeg ) = cone
         IF( klen.GT.1 ) THEN
            alpha = ( one-rcond ) / real( klen-1 )
            DO 170 i = 2, klen
               a( nz1+i, nz1+i ) = cmplx( real( klen-i )*alpha+rcond )
  170       CONTINUE
         END IF
         GO TO 220
*
*        abs(ITYPE) = 9: Randomly distributed D values on ( RCOND, 1):
*
  180    CONTINUE
         alpha = log( rcond )
         DO 190 jd = kbeg, kend
            a( jd, jd ) = exp( alpha*slaran( iseed ) )
  190    CONTINUE
         GO TO 220
*
*        abs(ITYPE) = 10: Randomly distributed D values from DIST
*
  200    CONTINUE
         DO 210 jd = kbeg, kend
            a( jd, jd ) = clarnd( idist, iseed )
  210    CONTINUE
*
  220    CONTINUE
*
*        Scale by AMAGN
*
         DO 230 jd = kbeg, kend
            a( jd, jd ) = amagn*real( a( jd, jd ) )
  230    CONTINUE
         DO 240 jd = isdb, isde
            a( jd+1, jd ) = amagn*real( a( jd+1, jd ) )
  240    CONTINUE
*
*        If RSIGN = .TRUE., assign random signs to diagonal and
*        subdiagonal
*
         IF( rsign ) THEN
            DO 250 jd = kbeg, kend
               IF( real( a( jd, jd ) ).NE.zero ) THEN
                  ctemp = clarnd( 3, iseed )
                  ctemp = ctemp / abs( ctemp )
                  a( jd, jd ) = ctemp*real( a( jd, jd ) )
               END IF
  250       CONTINUE
            DO 260 jd = isdb, isde
               IF( real( a( jd+1, jd ) ).NE.zero ) THEN
                  ctemp = clarnd( 3, iseed )
                  ctemp = ctemp / abs( ctemp )
                  a( jd+1, jd ) = ctemp*real( a( jd+1, jd ) )
               END IF
  260       CONTINUE
         END IF
*
*        Reverse if ITYPE < 0
*
         IF( itype.LT.0 ) THEN
            DO 270 jd = kbeg, ( kbeg+kend-1 ) / 2
               ctemp = a( jd, jd )
               a( jd, jd ) = a( kbeg+kend-jd, kbeg+kend-jd )
               a( kbeg+kend-jd, kbeg+kend-jd ) = ctemp
  270       CONTINUE
            DO 280 jd = 1, ( n-1 ) / 2
               ctemp = a( jd+1, jd )
               a( jd+1, jd ) = a( n+1-jd, n-jd )
               a( n+1-jd, n-jd ) = ctemp
  280       CONTINUE
         END IF
*
      END IF
*
*     Fill in upper triangle
*
      IF( triang.NE.zero ) THEN
         DO 300 jc = 2, n
            DO 290 jr = 1, jc - 1
               a( jr, jc ) = triang*clarnd( idist, iseed )
  290       CONTINUE
  300    CONTINUE
      END IF
*
      RETURN
*
*     End of CLATM4
*

Here is the call graph for this function:

Here is the caller graph for this function: