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

Definition at line 2922 of file cblat3.f.

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