LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 2307 of file c_cblat3.f.

2307 *
2308 * Generates values for an M by N matrix A.
2309 * Stores the values in the array AA in the data structure required
2310 * by the routine, with unwanted elements set to rogue value.
2311 *
2312 * TYPE is 'ge', 'he', 'sy' or 'tr'.
2313 *
2314 * Auxiliary routine for test program for Level 3 Blas.
2315 *
2316 * -- Written on 8-February-1989.
2317 * Jack Dongarra, Argonne National Laboratory.
2318 * Iain Duff, AERE Harwell.
2319 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2320 * Sven Hammarling, Numerical Algorithms Group Ltd.
2321 *
2322 * .. Parameters ..
2323  COMPLEX zero, one
2324  parameter ( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
2325  COMPLEX rogue
2326  parameter ( rogue = ( -1.0e10, 1.0e10 ) )
2327  REAL rzero
2328  parameter ( rzero = 0.0 )
2329  REAL rrogue
2330  parameter ( rrogue = -1.0e10 )
2331 * .. Scalar Arguments ..
2332  COMPLEX transl
2333  INTEGER lda, m, n, nmax
2334  LOGICAL reset
2335  CHARACTER*1 diag, uplo
2336  CHARACTER*2 type
2337 * .. Array Arguments ..
2338  COMPLEX a( nmax, * ), aa( * )
2339 * .. Local Scalars ..
2340  INTEGER i, ibeg, iend, j, jj
2341  LOGICAL gen, her, lower, sym, tri, unit, upper
2342 * .. External Functions ..
2343  COMPLEX cbeg
2344  EXTERNAL cbeg
2345 * .. Intrinsic Functions ..
2346  INTRINSIC cmplx, conjg, real
2347 * .. Executable Statements ..
2348  gen = type.EQ.'ge'
2349  her = type.EQ.'he'
2350  sym = type.EQ.'sy'
2351  tri = type.EQ.'tr'
2352  upper = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'U'
2353  lower = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'L'
2354  unit = tri.AND.diag.EQ.'U'
2355 *
2356 * Generate data in array A.
2357 *
2358  DO 20 j = 1, n
2359  DO 10 i = 1, m
2360  IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2361  $ THEN
2362  a( i, j ) = cbeg( reset ) + transl
2363  IF( i.NE.j )THEN
2364 * Set some elements to zero
2365  IF( n.GT.3.AND.j.EQ.n/2 )
2366  $ a( i, j ) = zero
2367  IF( her )THEN
2368  a( j, i ) = conjg( a( i, j ) )
2369  ELSE IF( sym )THEN
2370  a( j, i ) = a( i, j )
2371  ELSE IF( tri )THEN
2372  a( j, i ) = zero
2373  END IF
2374  END IF
2375  END IF
2376  10 CONTINUE
2377  IF( her )
2378  $ a( j, j ) = cmplx( REAL( A( J, J ) ), rzero )
2379  IF( tri )
2380  $ a( j, j ) = a( j, j ) + one
2381  IF( unit )
2382  $ a( j, j ) = one
2383  20 CONTINUE
2384 *
2385 * Store elements in array AS in data structure required by routine.
2386 *
2387  IF( type.EQ.'ge' )THEN
2388  DO 50 j = 1, n
2389  DO 30 i = 1, m
2390  aa( i + ( j - 1 )*lda ) = a( i, j )
2391  30 CONTINUE
2392  DO 40 i = m + 1, lda
2393  aa( i + ( j - 1 )*lda ) = rogue
2394  40 CONTINUE
2395  50 CONTINUE
2396  ELSE IF( type.EQ.'he'.OR.type.EQ.'sy'.OR.type.EQ.'tr' )THEN
2397  DO 90 j = 1, n
2398  IF( upper )THEN
2399  ibeg = 1
2400  IF( unit )THEN
2401  iend = j - 1
2402  ELSE
2403  iend = j
2404  END IF
2405  ELSE
2406  IF( unit )THEN
2407  ibeg = j + 1
2408  ELSE
2409  ibeg = j
2410  END IF
2411  iend = n
2412  END IF
2413  DO 60 i = 1, ibeg - 1
2414  aa( i + ( j - 1 )*lda ) = rogue
2415  60 CONTINUE
2416  DO 70 i = ibeg, iend
2417  aa( i + ( j - 1 )*lda ) = a( i, j )
2418  70 CONTINUE
2419  DO 80 i = iend + 1, lda
2420  aa( i + ( j - 1 )*lda ) = rogue
2421  80 CONTINUE
2422  IF( her )THEN
2423  jj = j + ( j - 1 )*lda
2424  aa( jj ) = cmplx( REAL( AA( JJ ) ), rrogue )
2425  END IF
2426  90 CONTINUE
2427  END IF
2428  RETURN
2429 *
2430 * End of CMAKE.
2431 *
complex function cbeg(RESET)
Definition: cblat2.f:3131