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

Definition at line 2719 of file cblat2.f.

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

Here is the caller graph for this function: