LAPACK  3.8.0
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,
logical  RESET,
complex*16  TRANSL 
)

Definition at line 2934 of file zblat3.f.

2934 *
2935 * Generates values for an M by N matrix A.
2936 * Stores the values in the array AA in the data structure required
2937 * by the routine, with unwanted elements set to rogue value.
2938 *
2939 * TYPE is 'GE', 'HE', 'SY' or 'TR'.
2940 *
2941 * Auxiliary routine for test program for Level 3 Blas.
2942 *
2943 * -- Written on 8-February-1989.
2944 * Jack Dongarra, Argonne National Laboratory.
2945 * Iain Duff, AERE Harwell.
2946 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2947 * Sven Hammarling, Numerical Algorithms Group Ltd.
2948 *
2949 * .. Parameters ..
2950  COMPLEX*16 zero, one
2951  parameter( zero = ( 0.0d0, 0.0d0 ),
2952  $ one = ( 1.0d0, 0.0d0 ) )
2953  COMPLEX*16 rogue
2954  parameter( rogue = ( -1.0d10, 1.0d10 ) )
2955  DOUBLE PRECISION rzero
2956  parameter( rzero = 0.0d0 )
2957  DOUBLE PRECISION rrogue
2958  parameter( rrogue = -1.0d10 )
2959 * .. Scalar Arguments ..
2960  COMPLEX*16 transl
2961  INTEGER lda, m, n, nmax
2962  LOGICAL reset
2963  CHARACTER*1 diag, uplo
2964  CHARACTER*2 type
2965 * .. Array Arguments ..
2966  COMPLEX*16 a( nmax, * ), aa( * )
2967 * .. Local Scalars ..
2968  INTEGER i, ibeg, iend, j, jj
2969  LOGICAL gen, her, lower, sym, tri, unit, upper
2970 * .. External Functions ..
2971  COMPLEX*16 zbeg
2972  EXTERNAL zbeg
2973 * .. Intrinsic Functions ..
2974  INTRINSIC dcmplx, dconjg, dble
2975 * .. Executable Statements ..
2976  gen = type.EQ.'GE'
2977  her = type.EQ.'HE'
2978  sym = type.EQ.'SY'
2979  tri = type.EQ.'TR'
2980  upper = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'U'
2981  lower = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'L'
2982  unit = tri.AND.diag.EQ.'U'
2983 *
2984 * Generate data in array A.
2985 *
2986  DO 20 j = 1, n
2987  DO 10 i = 1, m
2988  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2989  $ THEN
2990  a( i, j ) = zbeg( reset ) + transl
2991  IF( i.NE.j )THEN
2992 * Set some elements to zero
2993  IF( n.GT.3.AND.j.EQ.n/2 )
2994  $ a( i, j ) = zero
2995  IF( her )THEN
2996  a( j, i ) = dconjg( a( i, j ) )
2997  ELSE IF( sym )THEN
2998  a( j, i ) = a( i, j )
2999  ELSE IF( tri )THEN
3000  a( j, i ) = zero
3001  END IF
3002  END IF
3003  END IF
3004  10 CONTINUE
3005  IF( her )
3006  $ a( j, j ) = dcmplx( dble( a( j, j ) ), rzero )
3007  IF( tri )
3008  $ a( j, j ) = a( j, j ) + one
3009  IF( unit )
3010  $ a( j, j ) = one
3011  20 CONTINUE
3012 *
3013 * Store elements in array AS in data structure required by routine.
3014 *
3015  IF( type.EQ.'GE' )THEN
3016  DO 50 j = 1, n
3017  DO 30 i = 1, m
3018  aa( i + ( j - 1 )*lda ) = a( i, j )
3019  30 CONTINUE
3020  DO 40 i = m + 1, lda
3021  aa( i + ( j - 1 )*lda ) = rogue
3022  40 CONTINUE
3023  50 CONTINUE
3024  ELSE IF( type.EQ.'HE'.OR.type.EQ.'SY'.OR.type.EQ.'TR' )THEN
3025  DO 90 j = 1, n
3026  IF( upper )THEN
3027  ibeg = 1
3028  IF( unit )THEN
3029  iend = j - 1
3030  ELSE
3031  iend = j
3032  END IF
3033  ELSE
3034  IF( unit )THEN
3035  ibeg = j + 1
3036  ELSE
3037  ibeg = j
3038  END IF
3039  iend = n
3040  END IF
3041  DO 60 i = 1, ibeg - 1
3042  aa( i + ( j - 1 )*lda ) = rogue
3043  60 CONTINUE
3044  DO 70 i = ibeg, iend
3045  aa( i + ( j - 1 )*lda ) = a( i, j )
3046  70 CONTINUE
3047  DO 80 i = iend + 1, lda
3048  aa( i + ( j - 1 )*lda ) = rogue
3049  80 CONTINUE
3050  IF( her )THEN
3051  jj = j + ( j - 1 )*lda
3052  aa( jj ) = dcmplx( dble( aa( jj ) ), rrogue )
3053  END IF
3054  90 CONTINUE
3055  END IF
3056  RETURN
3057 *
3058 * End of ZMAKE.
3059 *
complex *16 function zbeg(RESET)
Definition: zblat2.f:3139