LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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 2676 of file dblat2.f.

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