LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zmake ( character*2  TYPE,
character*1  UPLO,
character*1  DIAG,
integer  M,
integer  N,
complex*16, dimension( nmax, * )  A,
integer  NMAX,
complex*16, dimension( * )  AA,
integer  LDA,
integer  KL,
integer  KU,
logical  RESET,
complex*16  TRANSL 
)

Definition at line 2749 of file c_zblat2.f.

2749 *
2750 * Generates values for an M by N matrix A within the bandwidth
2751 * defined by KL and KU.
2752 * Stores the values in the array AA in the data structure required
2753 * by the routine, with unwanted elements set to rogue value.
2754 *
2755 * TYPE is 'ge', 'gb', 'he', 'hb', 'hp', 'tr', 'tb' OR 'tp'.
2756 *
2757 * Auxiliary routine for test program for Level 2 Blas.
2758 *
2759 * -- Written on 10-August-1987.
2760 * Richard Hanson, Sandia National Labs.
2761 * Jeremy Du Croz, NAG Central Office.
2762 *
2763 * .. Parameters ..
2764  COMPLEX*16 zero, one
2765  parameter ( zero = ( 0.0d0, 0.0d0 ),
2766  $ one = ( 1.0d0, 0.0d0 ) )
2767  COMPLEX*16 rogue
2768  parameter ( rogue = ( -1.0d10, 1.0d10 ) )
2769  DOUBLE PRECISION rzero
2770  parameter ( rzero = 0.0d0 )
2771  DOUBLE PRECISION rrogue
2772  parameter ( rrogue = -1.0d10 )
2773 * .. Scalar Arguments ..
2774  COMPLEX*16 transl
2775  INTEGER kl, ku, lda, m, n, nmax
2776  LOGICAL reset
2777  CHARACTER*1 diag, uplo
2778  CHARACTER*2 type
2779 * .. Array Arguments ..
2780  COMPLEX*16 a( nmax, * ), aa( * )
2781 * .. Local Scalars ..
2782  INTEGER i, i1, i2, i3, ibeg, iend, ioff, j, jj, kk
2783  LOGICAL gen, lower, sym, tri, unit, upper
2784 * .. External Functions ..
2785  COMPLEX*16 zbeg
2786  EXTERNAL zbeg
2787 * .. Intrinsic Functions ..
2788  INTRINSIC dcmplx, dconjg, max, min, dble
2789 * .. Executable Statements ..
2790  gen = TYPE( 1: 1 ).EQ.'g'
2791  sym = TYPE( 1: 1 ).EQ.'h'
2792  tri = TYPE( 1: 1 ).EQ.'t'
2793  upper = ( sym.OR.tri ).AND.uplo.EQ.'U'
2794  lower = ( sym.OR.tri ).AND.uplo.EQ.'L'
2795  unit = tri.AND.diag.EQ.'U'
2796 *
2797 * Generate data in array A.
2798 *
2799  DO 20 j = 1, n
2800  DO 10 i = 1, m
2801  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2802  $ THEN
2803  IF( ( i.LE.j.AND.j - i.LE.ku ).OR.
2804  $ ( i.GE.j.AND.i - j.LE.kl ) )THEN
2805  a( i, j ) = zbeg( reset ) + transl
2806  ELSE
2807  a( i, j ) = zero
2808  END IF
2809  IF( i.NE.j )THEN
2810  IF( sym )THEN
2811  a( j, i ) = dconjg( a( i, j ) )
2812  ELSE IF( tri )THEN
2813  a( j, i ) = zero
2814  END IF
2815  END IF
2816  END IF
2817  10 CONTINUE
2818  IF( sym )
2819  $ a( j, j ) = dcmplx( dble( a( j, j ) ), rzero )
2820  IF( tri )
2821  $ a( j, j ) = a( j, j ) + one
2822  IF( unit )
2823  $ a( j, j ) = one
2824  20 CONTINUE
2825 *
2826 * Store elements in array AS in data structure required by routine.
2827 *
2828  IF( type.EQ.'ge' )THEN
2829  DO 50 j = 1, n
2830  DO 30 i = 1, m
2831  aa( i + ( j - 1 )*lda ) = a( i, j )
2832  30 CONTINUE
2833  DO 40 i = m + 1, lda
2834  aa( i + ( j - 1 )*lda ) = rogue
2835  40 CONTINUE
2836  50 CONTINUE
2837  ELSE IF( type.EQ.'gb' )THEN
2838  DO 90 j = 1, n
2839  DO 60 i1 = 1, ku + 1 - j
2840  aa( i1 + ( j - 1 )*lda ) = rogue
2841  60 CONTINUE
2842  DO 70 i2 = i1, min( kl + ku + 1, ku + 1 + m - j )
2843  aa( i2 + ( j - 1 )*lda ) = a( i2 + j - ku - 1, j )
2844  70 CONTINUE
2845  DO 80 i3 = i2, lda
2846  aa( i3 + ( j - 1 )*lda ) = rogue
2847  80 CONTINUE
2848  90 CONTINUE
2849  ELSE IF( type.EQ.'he'.OR.type.EQ.'tr' )THEN
2850  DO 130 j = 1, n
2851  IF( upper )THEN
2852  ibeg = 1
2853  IF( unit )THEN
2854  iend = j - 1
2855  ELSE
2856  iend = j
2857  END IF
2858  ELSE
2859  IF( unit )THEN
2860  ibeg = j + 1
2861  ELSE
2862  ibeg = j
2863  END IF
2864  iend = n
2865  END IF
2866  DO 100 i = 1, ibeg - 1
2867  aa( i + ( j - 1 )*lda ) = rogue
2868  100 CONTINUE
2869  DO 110 i = ibeg, iend
2870  aa( i + ( j - 1 )*lda ) = a( i, j )
2871  110 CONTINUE
2872  DO 120 i = iend + 1, lda
2873  aa( i + ( j - 1 )*lda ) = rogue
2874  120 CONTINUE
2875  IF( sym )THEN
2876  jj = j + ( j - 1 )*lda
2877  aa( jj ) = dcmplx( dble( aa( jj ) ), rrogue )
2878  END IF
2879  130 CONTINUE
2880  ELSE IF( type.EQ.'hb'.OR.type.EQ.'tb' )THEN
2881  DO 170 j = 1, n
2882  IF( upper )THEN
2883  kk = kl + 1
2884  ibeg = max( 1, kl + 2 - j )
2885  IF( unit )THEN
2886  iend = kl
2887  ELSE
2888  iend = kl + 1
2889  END IF
2890  ELSE
2891  kk = 1
2892  IF( unit )THEN
2893  ibeg = 2
2894  ELSE
2895  ibeg = 1
2896  END IF
2897  iend = min( kl + 1, 1 + m - j )
2898  END IF
2899  DO 140 i = 1, ibeg - 1
2900  aa( i + ( j - 1 )*lda ) = rogue
2901  140 CONTINUE
2902  DO 150 i = ibeg, iend
2903  aa( i + ( j - 1 )*lda ) = a( i + j - kk, j )
2904  150 CONTINUE
2905  DO 160 i = iend + 1, lda
2906  aa( i + ( j - 1 )*lda ) = rogue
2907  160 CONTINUE
2908  IF( sym )THEN
2909  jj = kk + ( j - 1 )*lda
2910  aa( jj ) = dcmplx( dble( aa( jj ) ), rrogue )
2911  END IF
2912  170 CONTINUE
2913  ELSE IF( type.EQ.'hp'.OR.type.EQ.'tp' )THEN
2914  ioff = 0
2915  DO 190 j = 1, n
2916  IF( upper )THEN
2917  ibeg = 1
2918  iend = j
2919  ELSE
2920  ibeg = j
2921  iend = n
2922  END IF
2923  DO 180 i = ibeg, iend
2924  ioff = ioff + 1
2925  aa( ioff ) = a( i, j )
2926  IF( i.EQ.j )THEN
2927  IF( unit )
2928  $ aa( ioff ) = rogue
2929  IF( sym )
2930  $ aa( ioff ) = dcmplx( dble( aa( ioff ) ), rrogue )
2931  END IF
2932  180 CONTINUE
2933  190 CONTINUE
2934  END IF
2935  RETURN
2936 *
2937 * End of ZMAKE.
2938 *
zbeg
complex *16 function zbeg(RESET)
Definition: zblat2.f:3139