LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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,
integer  KL,
integer  KU,
logical  RESET,
double precision  TRANSL 
)

Definition at line 2465 of file c_dblat2.f.

2465 *
2466 * Generates values for an M by N matrix A within the bandwidth
2467 * defined by KL and KU.
2468 * Stores the values in the array AA in the data structure required
2469 * by the routine, with unwanted elements set to rogue value.
2470 *
2471 * TYPE is 'ge', 'gb', 'sy', 'sb', 'sp', 'tr', 'tb' OR 'tp'.
2472 *
2473 * Auxiliary routine for test program for Level 2 Blas.
2474 *
2475 * -- Written on 10-August-1987.
2476 * Richard Hanson, Sandia National Labs.
2477 * Jeremy Du Croz, NAG Central Office.
2478 *
2479 * .. Parameters ..
2480  DOUBLE PRECISION zero, one
2481  parameter ( zero = 0.0d0, one = 1.0d0 )
2482  DOUBLE PRECISION rogue
2483  parameter ( rogue = -1.0d10 )
2484 * .. Scalar Arguments ..
2485  DOUBLE PRECISION transl
2486  INTEGER kl, ku, lda, m, n, nmax
2487  LOGICAL reset
2488  CHARACTER*1 diag, uplo
2489  CHARACTER*2 type
2490 * .. Array Arguments ..
2491  DOUBLE PRECISION a( nmax, * ), aa( * )
2492 * .. Local Scalars ..
2493  INTEGER i, i1, i2, i3, ibeg, iend, ioff, j, kk
2494  LOGICAL gen, lower, sym, tri, unit, upper
2495 * .. External Functions ..
2496  DOUBLE PRECISION dbeg
2497  EXTERNAL dbeg
2498 * .. Intrinsic Functions ..
2499  INTRINSIC max, min
2500 * .. Executable Statements ..
2501  gen = TYPE( 1: 1 ).EQ.'g'
2502  sym = TYPE( 1: 1 ).EQ.'s'
2503  tri = TYPE( 1: 1 ).EQ.'t'
2504  upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
2505  lower = ( sym.OR.tri ).AND.uplo.EQ.'L'
2506  unit = tri.AND.diag.EQ.'U'
2507 *
2508 * Generate data in array A.
2509 *
2510  DO 20 j = 1, n
2511  DO 10 i = 1, m
2512  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2513  $ THEN
2514  IF( ( i.LE.j.AND.j - i.LE.ku ).OR.
2515  $ ( i.GE.j.AND.i - j.LE.kl ) )THEN
2516  a( i, j ) = dbeg( reset ) + transl
2517  ELSE
2518  a( i, j ) = zero
2519  END IF
2520  IF( i.NE.j )THEN
2521  IF( sym )THEN
2522  a( j, i ) = a( i, j )
2523  ELSE IF( tri )THEN
2524  a( j, i ) = zero
2525  END IF
2526  END IF
2527  END IF
2528  10 CONTINUE
2529  IF( tri )
2530  $ a( j, j ) = a( j, j ) + one
2531  IF( unit )
2532  $ a( j, j ) = one
2533  20 CONTINUE
2534 *
2535 * Store elements in array AS in data structure required by routine.
2536 *
2537  IF( type.EQ.'ge' )THEN
2538  DO 50 j = 1, n
2539  DO 30 i = 1, m
2540  aa( i + ( j - 1 )*lda ) = a( i, j )
2541  30 CONTINUE
2542  DO 40 i = m + 1, lda
2543  aa( i + ( j - 1 )*lda ) = rogue
2544  40 CONTINUE
2545  50 CONTINUE
2546  ELSE IF( type.EQ.'gb' )THEN
2547  DO 90 j = 1, n
2548  DO 60 i1 = 1, ku + 1 - j
2549  aa( i1 + ( j - 1 )*lda ) = rogue
2550  60 CONTINUE
2551  DO 70 i2 = i1, min( kl + ku + 1, ku + 1 + m - j )
2552  aa( i2 + ( j - 1 )*lda ) = a( i2 + j - ku - 1, j )
2553  70 CONTINUE
2554  DO 80 i3 = i2, lda
2555  aa( i3 + ( j - 1 )*lda ) = rogue
2556  80 CONTINUE
2557  90 CONTINUE
2558  ELSE IF( type.EQ.'sy'.OR.type.EQ.'tr' )THEN
2559  DO 130 j = 1, n
2560  IF( upper )THEN
2561  ibeg = 1
2562  IF( unit )THEN
2563  iend = j - 1
2564  ELSE
2565  iend = j
2566  END IF
2567  ELSE
2568  IF( unit )THEN
2569  ibeg = j + 1
2570  ELSE
2571  ibeg = j
2572  END IF
2573  iend = n
2574  END IF
2575  DO 100 i = 1, ibeg - 1
2576  aa( i + ( j - 1 )*lda ) = rogue
2577  100 CONTINUE
2578  DO 110 i = ibeg, iend
2579  aa( i + ( j - 1 )*lda ) = a( i, j )
2580  110 CONTINUE
2581  DO 120 i = iend + 1, lda
2582  aa( i + ( j - 1 )*lda ) = rogue
2583  120 CONTINUE
2584  130 CONTINUE
2585  ELSE IF( type.EQ.'sb'.OR.type.EQ.'tb' )THEN
2586  DO 170 j = 1, n
2587  IF( upper )THEN
2588  kk = kl + 1
2589  ibeg = max( 1, kl + 2 - j )
2590  IF( unit )THEN
2591  iend = kl
2592  ELSE
2593  iend = kl + 1
2594  END IF
2595  ELSE
2596  kk = 1
2597  IF( unit )THEN
2598  ibeg = 2
2599  ELSE
2600  ibeg = 1
2601  END IF
2602  iend = min( kl + 1, 1 + m - j )
2603  END IF
2604  DO 140 i = 1, ibeg - 1
2605  aa( i + ( j - 1 )*lda ) = rogue
2606  140 CONTINUE
2607  DO 150 i = ibeg, iend
2608  aa( i + ( j - 1 )*lda ) = a( i + j - kk, j )
2609  150 CONTINUE
2610  DO 160 i = iend + 1, lda
2611  aa( i + ( j - 1 )*lda ) = rogue
2612  160 CONTINUE
2613  170 CONTINUE
2614  ELSE IF( type.EQ.'sp'.OR.type.EQ.'tp' )THEN
2615  ioff = 0
2616  DO 190 j = 1, n
2617  IF( upper )THEN
2618  ibeg = 1
2619  iend = j
2620  ELSE
2621  ibeg = j
2622  iend = n
2623  END IF
2624  DO 180 i = ibeg, iend
2625  ioff = ioff + 1
2626  aa( ioff ) = a( i, j )
2627  IF( i.EQ.j )THEN
2628  IF( unit )
2629  $ aa( ioff ) = rogue
2630  END IF
2631  180 CONTINUE
2632  190 CONTINUE
2633  END IF
2634  RETURN
2635 *
2636 * End of DMAKE.
2637 *
double precision function dbeg(RESET)
Definition: dblat2.f:3034