LAPACK  3.8.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 2397 of file sblat3.f.

2397 *
2398 * Generates values for an M by N matrix A.
2399 * Stores the values in the array AA in the data structure required
2400 * by the routine, with unwanted elements set to rogue value.
2401 *
2402 * TYPE is 'GE', 'SY' or 'TR'.
2403 *
2404 * Auxiliary routine for test program for Level 3 Blas.
2405 *
2406 * -- Written on 8-February-1989.
2407 * Jack Dongarra, Argonne National Laboratory.
2408 * Iain Duff, AERE Harwell.
2409 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2410 * Sven Hammarling, Numerical Algorithms Group Ltd.
2411 *
2412 * .. Parameters ..
2413  REAL zero, one
2414  parameter( zero = 0.0, one = 1.0 )
2415  REAL rogue
2416  parameter( rogue = -1.0e10 )
2417 * .. Scalar Arguments ..
2418  REAL transl
2419  INTEGER lda, m, n, nmax
2420  LOGICAL reset
2421  CHARACTER*1 diag, uplo
2422  CHARACTER*2 type
2423 * .. Array Arguments ..
2424  REAL a( nmax, * ), aa( * )
2425 * .. Local Scalars ..
2426  INTEGER i, ibeg, iend, j
2427  LOGICAL gen, lower, sym, tri, unit, upper
2428 * .. External Functions ..
2429  REAL sbeg
2430  EXTERNAL sbeg
2431 * .. Executable Statements ..
2432  gen = type.EQ.'GE'
2433  sym = type.EQ.'SY'
2434  tri = type.EQ.'TR'
2435  upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
2436  lower = ( sym.OR.tri ).AND.uplo.EQ.'L'
2437  unit = tri.AND.diag.EQ.'U'
2438 *
2439 * Generate data in array A.
2440 *
2441  DO 20 j = 1, n
2442  DO 10 i = 1, m
2443  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2444  $ THEN
2445  a( i, j ) = sbeg( reset ) + transl
2446  IF( i.NE.j )THEN
2447 * Set some elements to zero
2448  IF( n.GT.3.AND.j.EQ.n/2 )
2449  $ a( i, j ) = zero
2450  IF( sym )THEN
2451  a( j, i ) = a( i, j )
2452  ELSE IF( tri )THEN
2453  a( j, i ) = zero
2454  END IF
2455  END IF
2456  END IF
2457  10 CONTINUE
2458  IF( tri )
2459  $ a( j, j ) = a( j, j ) + one
2460  IF( unit )
2461  $ a( j, j ) = one
2462  20 CONTINUE
2463 *
2464 * Store elements in array AS in data structure required by routine.
2465 *
2466  IF( type.EQ.'GE' )THEN
2467  DO 50 j = 1, n
2468  DO 30 i = 1, m
2469  aa( i + ( j - 1 )*lda ) = a( i, j )
2470  30 CONTINUE
2471  DO 40 i = m + 1, lda
2472  aa( i + ( j - 1 )*lda ) = rogue
2473  40 CONTINUE
2474  50 CONTINUE
2475  ELSE IF( type.EQ.'SY'.OR.type.EQ.'TR' )THEN
2476  DO 90 j = 1, n
2477  IF( upper )THEN
2478  ibeg = 1
2479  IF( unit )THEN
2480  iend = j - 1
2481  ELSE
2482  iend = j
2483  END IF
2484  ELSE
2485  IF( unit )THEN
2486  ibeg = j + 1
2487  ELSE
2488  ibeg = j
2489  END IF
2490  iend = n
2491  END IF
2492  DO 60 i = 1, ibeg - 1
2493  aa( i + ( j - 1 )*lda ) = rogue
2494  60 CONTINUE
2495  DO 70 i = ibeg, iend
2496  aa( i + ( j - 1 )*lda ) = a( i, j )
2497  70 CONTINUE
2498  DO 80 i = iend + 1, lda
2499  aa( i + ( j - 1 )*lda ) = rogue
2500  80 CONTINUE
2501  90 CONTINUE
2502  END IF
2503  RETURN
2504 *
2505 * End of SMAKE.
2506 *
real function sbeg(RESET)
Definition: sblat2.f:3034