LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cmake()

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 2743 of file c_cblat2.f.

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