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 2726 of file zblat2.f.

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

Here is the caller graph for this function: