dmake()

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

Definition at line 2099 of file c_dblat3.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', '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 ..
      DOUBLE PRECISION   ZERO, ONE
      parameter( zero = 0.0d0, one = 1.0d0 )
      DOUBLE PRECISION   ROGUE
      parameter( rogue = -1.0d10 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   TRANSL
      INTEGER            LDA, M, N, NMAX
      LOGICAL            RESET
      CHARACTER*1        DIAG, UPLO
      CHARACTER*2        TYPE
*     .. Array Arguments ..
      DOUBLE PRECISION   A( NMAX, * ), AA( * )
*     .. Local Scalars ..
      INTEGER            I, IBEG, IEND, J
      LOGICAL            GEN, LOWER, SYM, TRI, UNIT, UPPER
*     .. External Functions ..
      DOUBLE PRECISION   DBEG
      EXTERNAL           dbeg
*     .. Executable Statements ..
      gen = type.EQ.'GE'
      sym = type.EQ.'SY'
      tri = type.EQ.'TR'
      upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
      lower = ( 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 ) = dbeg( 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( 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( 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.'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
   90    CONTINUE
      END IF
      RETURN
*
*     End of DMAKE.
*