LAPACK  3.10.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 2714 of file cblat2.f.

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