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

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