LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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 2083 of file c_dblat3.f.

2085 *
2086 * Generates values for an M by N matrix A.
2087 * Stores the values in the array AA in the data structure required
2088 * by the routine, with unwanted elements set to rogue value.
2089 *
2090 * TYPE is 'GE', 'SY' or 'TR'.
2091 *
2092 * Auxiliary routine for test program for Level 3 Blas.
2093 *
2094 * -- Written on 8-February-1989.
2095 * Jack Dongarra, Argonne National Laboratory.
2096 * Iain Duff, AERE Harwell.
2097 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2098 * Sven Hammarling, Numerical Algorithms Group Ltd.
2099 *
2100 * .. Parameters ..
2101  DOUBLE PRECISION ZERO, ONE
2102  parameter( zero = 0.0d0, one = 1.0d0 )
2103  DOUBLE PRECISION ROGUE
2104  parameter( rogue = -1.0d10 )
2105 * .. Scalar Arguments ..
2106  DOUBLE PRECISION TRANSL
2107  INTEGER LDA, M, N, NMAX
2108  LOGICAL RESET
2109  CHARACTER*1 DIAG, UPLO
2110  CHARACTER*2 TYPE
2111 * .. Array Arguments ..
2112  DOUBLE PRECISION A( NMAX, * ), AA( * )
2113 * .. Local Scalars ..
2114  INTEGER I, IBEG, IEND, J
2115  LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER
2116 * .. External Functions ..
2117  DOUBLE PRECISION DBEG
2118  EXTERNAL dbeg
2119 * .. Executable Statements ..
2120  gen = type.EQ.'GE'
2121  sym = type.EQ.'SY'
2122  tri = type.EQ.'TR'
2123  upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
2124  lower = ( sym.OR.tri ).AND.uplo.EQ.'L'
2125  unit = tri.AND.diag.EQ.'U'
2126 *
2127 * Generate data in array A.
2128 *
2129  DO 20 j = 1, n
2130  DO 10 i = 1, m
2131  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2132  $ THEN
2133  a( i, j ) = dbeg( reset ) + transl
2134  IF( i.NE.j )THEN
2135 * Set some elements to zero
2136  IF( n.GT.3.AND.j.EQ.n/2 )
2137  $ a( i, j ) = zero
2138  IF( sym )THEN
2139  a( j, i ) = a( i, j )
2140  ELSE IF( tri )THEN
2141  a( j, i ) = zero
2142  END IF
2143  END IF
2144  END IF
2145  10 CONTINUE
2146  IF( tri )
2147  $ a( j, j ) = a( j, j ) + one
2148  IF( unit )
2149  $ a( j, j ) = one
2150  20 CONTINUE
2151 *
2152 * Store elements in array AS in data structure required by routine.
2153 *
2154  IF( type.EQ.'GE' )THEN
2155  DO 50 j = 1, n
2156  DO 30 i = 1, m
2157  aa( i + ( j - 1 )*lda ) = a( i, j )
2158  30 CONTINUE
2159  DO 40 i = m + 1, lda
2160  aa( i + ( j - 1 )*lda ) = rogue
2161  40 CONTINUE
2162  50 CONTINUE
2163  ELSE IF( type.EQ.'SY'.OR.type.EQ.'TR' )THEN
2164  DO 90 j = 1, n
2165  IF( upper )THEN
2166  ibeg = 1
2167  IF( unit )THEN
2168  iend = j - 1
2169  ELSE
2170  iend = j
2171  END IF
2172  ELSE
2173  IF( unit )THEN
2174  ibeg = j + 1
2175  ELSE
2176  ibeg = j
2177  END IF
2178  iend = n
2179  END IF
2180  DO 60 i = 1, ibeg - 1
2181  aa( i + ( j - 1 )*lda ) = rogue
2182  60 CONTINUE
2183  DO 70 i = ibeg, iend
2184  aa( i + ( j - 1 )*lda ) = a( i, j )
2185  70 CONTINUE
2186  DO 80 i = iend + 1, lda
2187  aa( i + ( j - 1 )*lda ) = rogue
2188  80 CONTINUE
2189  90 CONTINUE
2190  END IF
2191  RETURN
2192 *
2193 * End of DMAKE.
2194 *
double precision function dbeg(RESET)
Definition: dblat2.f:3031