cmake()

subroutine cmake	(	character*2	type,
		character*1	uplo,
		character*1	diag,
		integer	m,
		integer	n,
		complex, dimension( nmax, * )	a,
		integer	nmax,
		complex, dimension( * )	aa,
		integer	lda,
		logical	reset,
		complex	transl
	)

Definition at line 2922 of file cblat3.f.

*
*  Generates values for an M by N matrix A.
*  Stores the values in the array AA in the data structure required
*  by the routine, with unwanted elements set to rogue value.
*
*  TYPE is 'GE', 'HE', 'SY' or 'TR'.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX            ZERO, ONE
      parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
      COMPLEX            ROGUE
      parameter( rogue = ( -1.0e10, 1.0e10 ) )
      REAL               RZERO
      parameter( rzero = 0.0 )
      REAL               RROGUE
      parameter( rrogue = -1.0e10 )
*     .. Scalar Arguments ..
      COMPLEX            TRANSL
      INTEGER            LDA, M, N, NMAX
      LOGICAL            RESET
      CHARACTER*1        DIAG, UPLO
      CHARACTER*2        TYPE
*     .. Array Arguments ..
      COMPLEX            A( NMAX, * ), AA( * )
*     .. Local Scalars ..
      INTEGER            I, IBEG, IEND, J, JJ
      LOGICAL            GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
*     .. External Functions ..
      COMPLEX            CBEG
      EXTERNAL           cbeg
*     .. Intrinsic Functions ..
      INTRINSIC          cmplx, conjg, real
*     .. Executable Statements ..
      gen = type.EQ.'GE'
      her = type.EQ.'HE'
      sym = type.EQ.'SY'
      tri = type.EQ.'TR'
      upper = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'U'
      lower = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'L'
      unit = tri.AND.diag.EQ.'U'
*
*     Generate data in array A.
*
      DO 20 j = 1, n
         DO 10 i = 1, m
            IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
     $          THEN
               a( i, j ) = cbeg( reset ) + transl
               IF( i.NE.j )THEN
*                 Set some elements to zero
                  IF( n.GT.3.AND.j.EQ.n/2 )
     $               a( i, j ) = zero
                  IF( her )THEN
                     a( j, i ) = conjg( a( i, j ) )
                  ELSE IF( sym )THEN
                     a( j, i ) = a( i, j )
                  ELSE IF( tri )THEN
                     a( j, i ) = zero
                  END IF
               END IF
            END IF
   10    CONTINUE
         IF( her )
     $      a( j, j ) = cmplx( real( a( j, j ) ), rzero )
         IF( tri )
     $      a( j, j ) = a( j, j ) + one
         IF( unit )
     $      a( j, j ) = one
   20 CONTINUE
*
*     Store elements in array AS in data structure required by routine.
*
      IF( type.EQ.'GE' )THEN
         DO 50 j = 1, n
            DO 30 i = 1, m
               aa( i + ( j - 1 )*lda ) = a( i, j )
   30       CONTINUE
            DO 40 i = m + 1, lda
               aa( i + ( j - 1 )*lda ) = rogue
   40       CONTINUE
   50    CONTINUE
      ELSE IF( type.EQ.'HE'.OR.type.EQ.'SY'.OR.type.EQ.'TR' )THEN
         DO 90 j = 1, n
            IF( upper )THEN
               ibeg = 1
               IF( unit )THEN
                  iend = j - 1
               ELSE
                  iend = j
               END IF
            ELSE
               IF( unit )THEN
                  ibeg = j + 1
               ELSE
                  ibeg = j
               END IF
               iend = n
            END IF
            DO 60 i = 1, ibeg - 1
               aa( i + ( j - 1 )*lda ) = rogue
   60       CONTINUE
            DO 70 i = ibeg, iend
               aa( i + ( j - 1 )*lda ) = a( i, j )
   70       CONTINUE
            DO 80 i = iend + 1, lda
               aa( i + ( j - 1 )*lda ) = rogue
   80       CONTINUE
            IF( her )THEN
               jj = j + ( j - 1 )*lda
               aa( jj ) = cmplx( real( aa( jj ) ), rrogue )
            END IF
   90    CONTINUE
      END IF
      RETURN
*
*     End of CMAKE
*