LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zmake()

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

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