LAPACK  3.8.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,
logical  RESET,
complex  TRANSL 
)

Definition at line 2927 of file cblat3.f.

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