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

Definition at line 2648 of file dblat2.f.

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