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 2392 of file dblat3.f.

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