LAPACK  3.8.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,
integer  KL,
integer  KU,
logical  RESET,
double precision  TRANSL 
)

Definition at line 2653 of file dblat2.f.

2653 *
2654 * Generates values for an M by N matrix A within the bandwidth
2655 * defined by KL and KU.
2656 * Stores the values in the array AA in the data structure required
2657 * by the routine, with unwanted elements set to rogue value.
2658 *
2659 * TYPE is 'GE', 'GB', 'SY', 'SB', 'SP', 'TR', 'TB' OR 'TP'.
2660 *
2661 * Auxiliary routine for test program for Level 2 Blas.
2662 *
2663 * -- Written on 10-August-1987.
2664 * Richard Hanson, Sandia National Labs.
2665 * Jeremy Du Croz, NAG Central Office.
2666 *
2667 * .. Parameters ..
2668  DOUBLE PRECISION zero, one
2669  parameter( zero = 0.0d0, one = 1.0d0 )
2670  DOUBLE PRECISION rogue
2671  parameter( rogue = -1.0d10 )
2672 * .. Scalar Arguments ..
2673  DOUBLE PRECISION transl
2674  INTEGER kl, ku, lda, m, n, nmax
2675  LOGICAL reset
2676  CHARACTER*1 diag, uplo
2677  CHARACTER*2 type
2678 * .. Array Arguments ..
2679  DOUBLE PRECISION a( nmax, * ), aa( * )
2680 * .. Local Scalars ..
2681  INTEGER i, i1, i2, i3, ibeg, iend, ioff, j, kk
2682  LOGICAL gen, lower, sym, tri, unit, upper
2683 * .. External Functions ..
2684  DOUBLE PRECISION dbeg
2685  EXTERNAL dbeg
2686 * .. Intrinsic Functions ..
2687  INTRINSIC max, min
2688 * .. Executable Statements ..
2689  gen = TYPE( 1: 1 ).EQ.'G'
2690  sym = TYPE( 1: 1 ).EQ.'S'
2691  tri = TYPE( 1: 1 ).EQ.'T'
2692  upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
2693  lower = ( sym.OR.tri ).AND.uplo.EQ.'L'
2694  unit = tri.AND.diag.EQ.'U'
2695 *
2696 * Generate data in array A.
2697 *
2698  DO 20 j = 1, n
2699  DO 10 i = 1, m
2700  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2701  $ THEN
2702  IF( ( i.LE.j.AND.j - i.LE.ku ).OR.
2703  $ ( i.GE.j.AND.i - j.LE.kl ) )THEN
2704  a( i, j ) = dbeg( reset ) + transl
2705  ELSE
2706  a( i, j ) = zero
2707  END IF
2708  IF( i.NE.j )THEN
2709  IF( sym )THEN
2710  a( j, i ) = a( i, j )
2711  ELSE IF( tri )THEN
2712  a( j, i ) = zero
2713  END IF
2714  END IF
2715  END IF
2716  10 CONTINUE
2717  IF( tri )
2718  $ a( j, j ) = a( j, j ) + one
2719  IF( unit )
2720  $ a( j, j ) = one
2721  20 CONTINUE
2722 *
2723 * Store elements in array AS in data structure required by routine.
2724 *
2725  IF( type.EQ.'GE' )THEN
2726  DO 50 j = 1, n
2727  DO 30 i = 1, m
2728  aa( i + ( j - 1 )*lda ) = a( i, j )
2729  30 CONTINUE
2730  DO 40 i = m + 1, lda
2731  aa( i + ( j - 1 )*lda ) = rogue
2732  40 CONTINUE
2733  50 CONTINUE
2734  ELSE IF( type.EQ.'GB' )THEN
2735  DO 90 j = 1, n
2736  DO 60 i1 = 1, ku + 1 - j
2737  aa( i1 + ( j - 1 )*lda ) = rogue
2738  60 CONTINUE
2739  DO 70 i2 = i1, min( kl + ku + 1, ku + 1 + m - j )
2740  aa( i2 + ( j - 1 )*lda ) = a( i2 + j - ku - 1, j )
2741  70 CONTINUE
2742  DO 80 i3 = i2, lda
2743  aa( i3 + ( j - 1 )*lda ) = rogue
2744  80 CONTINUE
2745  90 CONTINUE
2746  ELSE IF( type.EQ.'SY'.OR.type.EQ.'TR' )THEN
2747  DO 130 j = 1, n
2748  IF( upper )THEN
2749  ibeg = 1
2750  IF( unit )THEN
2751  iend = j - 1
2752  ELSE
2753  iend = j
2754  END IF
2755  ELSE
2756  IF( unit )THEN
2757  ibeg = j + 1
2758  ELSE
2759  ibeg = j
2760  END IF
2761  iend = n
2762  END IF
2763  DO 100 i = 1, ibeg - 1
2764  aa( i + ( j - 1 )*lda ) = rogue
2765  100 CONTINUE
2766  DO 110 i = ibeg, iend
2767  aa( i + ( j - 1 )*lda ) = a( i, j )
2768  110 CONTINUE
2769  DO 120 i = iend + 1, lda
2770  aa( i + ( j - 1 )*lda ) = rogue
2771  120 CONTINUE
2772  130 CONTINUE
2773  ELSE IF( type.EQ.'SB'.OR.type.EQ.'TB' )THEN
2774  DO 170 j = 1, n
2775  IF( upper )THEN
2776  kk = kl + 1
2777  ibeg = max( 1, kl + 2 - j )
2778  IF( unit )THEN
2779  iend = kl
2780  ELSE
2781  iend = kl + 1
2782  END IF
2783  ELSE
2784  kk = 1
2785  IF( unit )THEN
2786  ibeg = 2
2787  ELSE
2788  ibeg = 1
2789  END IF
2790  iend = min( kl + 1, 1 + m - j )
2791  END IF
2792  DO 140 i = 1, ibeg - 1
2793  aa( i + ( j - 1 )*lda ) = rogue
2794  140 CONTINUE
2795  DO 150 i = ibeg, iend
2796  aa( i + ( j - 1 )*lda ) = a( i + j - kk, j )
2797  150 CONTINUE
2798  DO 160 i = iend + 1, lda
2799  aa( i + ( j - 1 )*lda ) = rogue
2800  160 CONTINUE
2801  170 CONTINUE
2802  ELSE IF( type.EQ.'SP'.OR.type.EQ.'TP' )THEN
2803  ioff = 0
2804  DO 190 j = 1, n
2805  IF( upper )THEN
2806  ibeg = 1
2807  iend = j
2808  ELSE
2809  ibeg = j
2810  iend = n
2811  END IF
2812  DO 180 i = ibeg, iend
2813  ioff = ioff + 1
2814  aa( ioff ) = a( i, j )
2815  IF( i.EQ.j )THEN
2816  IF( unit )
2817  $ aa( ioff ) = rogue
2818  END IF
2819  180 CONTINUE
2820  190 CONTINUE
2821  END IF
2822  RETURN
2823 *
2824 * End of DMAKE.
2825 *
double precision function dbeg(RESET)
Definition: dblat2.f:3034
Here is the caller graph for this function: