LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ smake()

subroutine smake ( character*2  TYPE,
character*1  UPLO,
character*1  DIAG,
integer  M,
integer  N,
real, dimension( nmax, * )  A,
integer  NMAX,
real, dimension( * )  AA,
integer  LDA,
logical  RESET,
real  TRANSL 
)

Definition at line 2087 of file c_sblat3.f.

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