LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
zblat3.f
Go to the documentation of this file.
1 *> \brief \b ZBLAT3
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * PROGRAM ZBLAT3
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> Test program for the COMPLEX*16 Level 3 Blas.
20 *>
21 *> The program must be driven by a short data file. The first 14 records
22 *> of the file are read using list-directed input, the last 9 records
23 *> are read using the format ( A6, L2 ). An annotated example of a data
24 *> file can be obtained by deleting the first 3 characters from the
25 *> following 23 lines:
26 *> 'zblat3.out' NAME OF SUMMARY OUTPUT FILE
27 *> 6 UNIT NUMBER OF SUMMARY FILE
28 *> 'ZBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
29 *> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
30 *> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
31 *> F LOGICAL FLAG, T TO STOP ON FAILURES.
32 *> T LOGICAL FLAG, T TO TEST ERROR EXITS.
33 *> 16.0 THRESHOLD VALUE OF TEST RATIO
34 *> 6 NUMBER OF VALUES OF N
35 *> 0 1 2 3 5 9 VALUES OF N
36 *> 3 NUMBER OF VALUES OF ALPHA
37 *> (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
38 *> 3 NUMBER OF VALUES OF BETA
39 *> (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
40 *> ZGEMM T PUT F FOR NO TEST. SAME COLUMNS.
41 *> ZHEMM T PUT F FOR NO TEST. SAME COLUMNS.
42 *> ZSYMM T PUT F FOR NO TEST. SAME COLUMNS.
43 *> ZTRMM T PUT F FOR NO TEST. SAME COLUMNS.
44 *> ZTRSM T PUT F FOR NO TEST. SAME COLUMNS.
45 *> ZHERK T PUT F FOR NO TEST. SAME COLUMNS.
46 *> ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
47 *> ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
48 *> ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
49 *>
50 *>
51 *> Further Details
52 *> ===============
53 *>
54 *> See:
55 *>
56 *> Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
57 *> A Set of Level 3 Basic Linear Algebra Subprograms.
58 *>
59 *> Technical Memorandum No.88 (Revision 1), Mathematics and
60 *> Computer Science Division, Argonne National Laboratory, 9700
61 *> South Cass Avenue, Argonne, Illinois 60439, US.
62 *>
63 *> -- Written on 8-February-1989.
64 *> Jack Dongarra, Argonne National Laboratory.
65 *> Iain Duff, AERE Harwell.
66 *> Jeremy Du Croz, Numerical Algorithms Group Ltd.
67 *> Sven Hammarling, Numerical Algorithms Group Ltd.
68 *>
69 *> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
70 *> can be run multiple times without deleting generated
71 *> output files (susan)
72 *> \endverbatim
73 *
74 * Authors:
75 * ========
76 *
77 *> \author Univ. of Tennessee
78 *> \author Univ. of California Berkeley
79 *> \author Univ. of Colorado Denver
80 *> \author NAG Ltd.
81 *
82 *> \date April 2012
83 *
84 *> \ingroup complex16_blas_testing
85 *
86 * =====================================================================
87  PROGRAM zblat3
88 *
89 * -- Reference BLAS test routine (version 3.7.0) --
90 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
91 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
92 * April 2012
93 *
94 * =====================================================================
95 *
96 * .. Parameters ..
97  INTEGER nin
98  parameter( nin = 5 )
99  INTEGER nsubs
100  parameter( nsubs = 9 )
101  COMPLEX*16 zero, one
102  parameter( zero = ( 0.0d0, 0.0d0 ),
103  $ one = ( 1.0d0, 0.0d0 ) )
104  DOUBLE PRECISION rzero
105  parameter( rzero = 0.0d0 )
106  INTEGER nmax
107  parameter( nmax = 65 )
108  INTEGER nidmax, nalmax, nbemax
109  parameter( nidmax = 9, nalmax = 7, nbemax = 7 )
110 * .. Local Scalars ..
111  DOUBLE PRECISION eps, err, thresh
112  INTEGER i, isnum, j, n, nalf, nbet, nidim, nout, ntra
113  LOGICAL fatal, ltestt, rewi, same, sfatal, trace,
114  $ tsterr
115  CHARACTER*1 transa, transb
116  CHARACTER*6 snamet
117  CHARACTER*32 snaps, summry
118 * .. Local Arrays ..
119  COMPLEX*16 aa( nmax*nmax ), ab( nmax, 2*nmax ),
120  $ alf( nalmax ), as( nmax*nmax ),
121  $ bb( nmax*nmax ), bet( nbemax ),
122  $ bs( nmax*nmax ), c( nmax, nmax ),
123  $ cc( nmax*nmax ), cs( nmax*nmax ), ct( nmax ),
124  $ w( 2*nmax )
125  DOUBLE PRECISION g( nmax )
126  INTEGER idim( nidmax )
127  LOGICAL ltest( nsubs )
128  CHARACTER*6 snames( nsubs )
129 * .. External Functions ..
130  DOUBLE PRECISION ddiff
131  LOGICAL lze
132  EXTERNAL ddiff, lze
133 * .. External Subroutines ..
134  EXTERNAL zchk1, zchk2, zchk3, zchk4, zchk5, zchke, zmmch
135 * .. Intrinsic Functions ..
136  INTRINSIC max, min
137 * .. Scalars in Common ..
138  INTEGER infot, noutc
139  LOGICAL lerr, ok
140  CHARACTER*6 srnamt
141 * .. Common blocks ..
142  COMMON /infoc/infot, noutc, ok, lerr
143  COMMON /srnamc/srnamt
144 * .. Data statements ..
145  DATA snames/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ',
146  $ 'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K',
147  $ 'ZSYR2K'/
148 * .. Executable Statements ..
149 *
150 * Read name and unit number for summary output file and open file.
151 *
152  READ( nin, fmt = * )summry
153  READ( nin, fmt = * )nout
154  OPEN( nout, file = summry, status = 'UNKNOWN' )
155  noutc = nout
156 *
157 * Read name and unit number for snapshot output file and open file.
158 *
159  READ( nin, fmt = * )snaps
160  READ( nin, fmt = * )ntra
161  trace = ntra.GE.0
162  IF( trace )THEN
163  OPEN( ntra, file = snaps, status = 'UNKNOWN' )
164  END IF
165 * Read the flag that directs rewinding of the snapshot file.
166  READ( nin, fmt = * )rewi
167  rewi = rewi.AND.trace
168 * Read the flag that directs stopping on any failure.
169  READ( nin, fmt = * )sfatal
170 * Read the flag that indicates whether error exits are to be tested.
171  READ( nin, fmt = * )tsterr
172 * Read the threshold value of the test ratio
173  READ( nin, fmt = * )thresh
174 *
175 * Read and check the parameter values for the tests.
176 *
177 * Values of N
178  READ( nin, fmt = * )nidim
179  IF( nidim.LT.1.OR.nidim.GT.nidmax )THEN
180  WRITE( nout, fmt = 9997 )'N', nidmax
181  GO TO 220
182  END IF
183  READ( nin, fmt = * )( idim( i ), i = 1, nidim )
184  DO 10 i = 1, nidim
185  IF( idim( i ).LT.0.OR.idim( i ).GT.nmax )THEN
186  WRITE( nout, fmt = 9996 )nmax
187  GO TO 220
188  END IF
189  10 CONTINUE
190 * Values of ALPHA
191  READ( nin, fmt = * )nalf
192  IF( nalf.LT.1.OR.nalf.GT.nalmax )THEN
193  WRITE( nout, fmt = 9997 )'ALPHA', nalmax
194  GO TO 220
195  END IF
196  READ( nin, fmt = * )( alf( i ), i = 1, nalf )
197 * Values of BETA
198  READ( nin, fmt = * )nbet
199  IF( nbet.LT.1.OR.nbet.GT.nbemax )THEN
200  WRITE( nout, fmt = 9997 )'BETA', nbemax
201  GO TO 220
202  END IF
203  READ( nin, fmt = * )( bet( i ), i = 1, nbet )
204 *
205 * Report values of parameters.
206 *
207  WRITE( nout, fmt = 9995 )
208  WRITE( nout, fmt = 9994 )( idim( i ), i = 1, nidim )
209  WRITE( nout, fmt = 9993 )( alf( i ), i = 1, nalf )
210  WRITE( nout, fmt = 9992 )( bet( i ), i = 1, nbet )
211  IF( .NOT.tsterr )THEN
212  WRITE( nout, fmt = * )
213  WRITE( nout, fmt = 9984 )
214  END IF
215  WRITE( nout, fmt = * )
216  WRITE( nout, fmt = 9999 )thresh
217  WRITE( nout, fmt = * )
218 *
219 * Read names of subroutines and flags which indicate
220 * whether they are to be tested.
221 *
222  DO 20 i = 1, nsubs
223  ltest( i ) = .false.
224  20 CONTINUE
225  30 READ( nin, fmt = 9988, END = 60 )SNAMET, ltestt
226  DO 40 i = 1, nsubs
227  IF( snamet.EQ.snames( i ) )
228  $ GO TO 50
229  40 CONTINUE
230  WRITE( nout, fmt = 9990 )snamet
231  stop
232  50 ltest( i ) = ltestt
233  GO TO 30
234 *
235  60 CONTINUE
236  CLOSE ( nin )
237 *
238 * Compute EPS (the machine precision).
239 *
240  eps = epsilon(rzero)
241  WRITE( nout, fmt = 9998 )eps
242 *
243 * Check the reliability of ZMMCH using exact data.
244 *
245  n = min( 32, nmax )
246  DO 100 j = 1, n
247  DO 90 i = 1, n
248  ab( i, j ) = max( i - j + 1, 0 )
249  90 CONTINUE
250  ab( j, nmax + 1 ) = j
251  ab( 1, nmax + j ) = j
252  c( j, 1 ) = zero
253  100 CONTINUE
254  DO 110 j = 1, n
255  cc( j ) = j*( ( j + 1 )*j )/2 - ( ( j + 1 )*j*( j - 1 ) )/3
256  110 CONTINUE
257 * CC holds the exact result. On exit from ZMMCH CT holds
258 * the result computed by ZMMCH.
259  transa = 'N'
260  transb = 'N'
261  CALL zmmch( transa, transb, n, 1, n, one, ab, nmax,
262  $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
263  $ nmax, eps, err, fatal, nout, .true. )
264  same = lze( cc, ct, n )
265  IF( .NOT.same.OR.err.NE.rzero )THEN
266  WRITE( nout, fmt = 9989 )transa, transb, same, err
267  stop
268  END IF
269  transb = 'C'
270  CALL zmmch( transa, transb, n, 1, n, one, ab, nmax,
271  $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
272  $ nmax, eps, err, fatal, nout, .true. )
273  same = lze( cc, ct, n )
274  IF( .NOT.same.OR.err.NE.rzero )THEN
275  WRITE( nout, fmt = 9989 )transa, transb, same, err
276  stop
277  END IF
278  DO 120 j = 1, n
279  ab( j, nmax + 1 ) = n - j + 1
280  ab( 1, nmax + j ) = n - j + 1
281  120 CONTINUE
282  DO 130 j = 1, n
283  cc( n - j + 1 ) = j*( ( j + 1 )*j )/2 -
284  $ ( ( j + 1 )*j*( j - 1 ) )/3
285  130 CONTINUE
286  transa = 'C'
287  transb = 'N'
288  CALL zmmch( transa, transb, n, 1, n, one, ab, nmax,
289  $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
290  $ nmax, eps, err, fatal, nout, .true. )
291  same = lze( cc, ct, n )
292  IF( .NOT.same.OR.err.NE.rzero )THEN
293  WRITE( nout, fmt = 9989 )transa, transb, same, err
294  stop
295  END IF
296  transb = 'C'
297  CALL zmmch( transa, transb, n, 1, n, one, ab, nmax,
298  $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
299  $ nmax, eps, err, fatal, nout, .true. )
300  same = lze( cc, ct, n )
301  IF( .NOT.same.OR.err.NE.rzero )THEN
302  WRITE( nout, fmt = 9989 )transa, transb, same, err
303  stop
304  END IF
305 *
306 * Test each subroutine in turn.
307 *
308  DO 200 isnum = 1, nsubs
309  WRITE( nout, fmt = * )
310  IF( .NOT.ltest( isnum ) )THEN
311 * Subprogram is not to be tested.
312  WRITE( nout, fmt = 9987 )snames( isnum )
313  ELSE
314  srnamt = snames( isnum )
315 * Test error exits.
316  IF( tsterr )THEN
317  CALL zchke( isnum, snames( isnum ), nout )
318  WRITE( nout, fmt = * )
319  END IF
320 * Test computations.
321  infot = 0
322  ok = .true.
323  fatal = .false.
324  GO TO ( 140, 150, 150, 160, 160, 170, 170,
325  $ 180, 180 )isnum
326 * Test ZGEMM, 01.
327  140 CALL zchk1( snames( isnum ), eps, thresh, nout, ntra, trace,
328  $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
329  $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
330  $ cc, cs, ct, g )
331  GO TO 190
332 * Test ZHEMM, 02, ZSYMM, 03.
333  150 CALL zchk2( snames( isnum ), eps, thresh, nout, ntra, trace,
334  $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
335  $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
336  $ cc, cs, ct, g )
337  GO TO 190
338 * Test ZTRMM, 04, ZTRSM, 05.
339  160 CALL zchk3( snames( isnum ), eps, thresh, nout, ntra, trace,
340  $ rewi, fatal, nidim, idim, nalf, alf, nmax, ab,
341  $ aa, as, ab( 1, nmax + 1 ), bb, bs, ct, g, c )
342  GO TO 190
343 * Test ZHERK, 06, ZSYRK, 07.
344  170 CALL zchk4( snames( isnum ), eps, thresh, nout, ntra, trace,
345  $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
346  $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
347  $ cc, cs, ct, g )
348  GO TO 190
349 * Test ZHER2K, 08, ZSYR2K, 09.
350  180 CALL zchk5( snames( isnum ), eps, thresh, nout, ntra, trace,
351  $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
352  $ nmax, ab, aa, as, bb, bs, c, cc, cs, ct, g, w )
353  GO TO 190
354 *
355  190 IF( fatal.AND.sfatal )
356  $ GO TO 210
357  END IF
358  200 CONTINUE
359  WRITE( nout, fmt = 9986 )
360  GO TO 230
361 *
362  210 CONTINUE
363  WRITE( nout, fmt = 9985 )
364  GO TO 230
365 *
366  220 CONTINUE
367  WRITE( nout, fmt = 9991 )
368 *
369  230 CONTINUE
370  IF( trace )
371  $ CLOSE ( ntra )
372  CLOSE ( nout )
373  stop
374 *
375  9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
376  $ 'S THAN', f8.2 )
377  9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1p, d9.1 )
378  9997 FORMAT( ' NUMBER OF VALUES OF ', a, ' IS LESS THAN 1 OR GREATER ',
379  $ 'THAN ', i2 )
380  9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', i2 )
381  9995 FORMAT( ' TESTS OF THE COMPLEX*16 LEVEL 3 BLAS', //' THE F',
382  $ 'OLLOWING PARAMETER VALUES WILL BE USED:' )
383  9994 FORMAT( ' FOR N ', 9i6 )
384  9993 FORMAT( ' FOR ALPHA ',
385  $ 7( '(', f4.1, ',', f4.1, ') ', : ) )
386  9992 FORMAT( ' FOR BETA ',
387  $ 7( '(', f4.1, ',', f4.1, ') ', : ) )
388  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
389  $ /' ******* TESTS ABANDONED *******' )
390  9990 FORMAT( ' SUBPROGRAM NAME ', a6, ' NOT RECOGNIZED', /' ******* T',
391  $ 'ESTS ABANDONED *******' )
392  9989 FORMAT( ' ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
393  $ 'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', a1,
394  $ ' AND TRANSB = ', a1, /' AND RETURNED SAME = ', l1, ' AND ',
395  $ 'ERR = ', f12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
396  $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
397  $ '*******' )
398  9988 FORMAT( a6, l2 )
399  9987 FORMAT( 1x, a6, ' WAS NOT TESTED' )
400  9986 FORMAT( /' END OF TESTS' )
401  9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
402  9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
403 *
404 * End of ZBLAT3.
405 *
406  END
407  SUBROUTINE zchk1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
408  $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
409  $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
410 *
411 * Tests ZGEMM.
412 *
413 * Auxiliary routine for test program for Level 3 Blas.
414 *
415 * -- Written on 8-February-1989.
416 * Jack Dongarra, Argonne National Laboratory.
417 * Iain Duff, AERE Harwell.
418 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
419 * Sven Hammarling, Numerical Algorithms Group Ltd.
420 *
421 * .. Parameters ..
422  COMPLEX*16 ZERO
423  PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ) )
424  DOUBLE PRECISION RZERO
425  parameter( rzero = 0.0d0 )
426 * .. Scalar Arguments ..
427  DOUBLE PRECISION EPS, THRESH
428  INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
429  LOGICAL FATAL, REWI, TRACE
430  CHARACTER*6 SNAME
431 * .. Array Arguments ..
432  COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
433  $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
434  $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
435  $ c( nmax, nmax ), cc( nmax*nmax ),
436  $ cs( nmax*nmax ), ct( nmax )
437  DOUBLE PRECISION G( NMAX )
438  INTEGER IDIM( NIDIM )
439 * .. Local Scalars ..
440  COMPLEX*16 ALPHA, ALS, BETA, BLS
441  DOUBLE PRECISION ERR, ERRMAX
442  INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
443  $ lbb, lcc, lda, ldas, ldb, ldbs, ldc, ldcs, m,
444  $ ma, mb, ms, n, na, nargs, nb, nc, ns
445  LOGICAL NULL, RESET, SAME, TRANA, TRANB
446  CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB
447  CHARACTER*3 ICH
448 * .. Local Arrays ..
449  LOGICAL ISAME( 13 )
450 * .. External Functions ..
451  LOGICAL LZE, LZERES
452  EXTERNAL LZE, LZERES
453 * .. External Subroutines ..
454  EXTERNAL zgemm, zmake, zmmch
455 * .. Intrinsic Functions ..
456  INTRINSIC max
457 * .. Scalars in Common ..
458  INTEGER INFOT, NOUTC
459  LOGICAL LERR, OK
460 * .. Common blocks ..
461  COMMON /infoc/infot, noutc, ok, lerr
462 * .. Data statements ..
463  DATA ich/'NTC'/
464 * .. Executable Statements ..
465 *
466  nargs = 13
467  nc = 0
468  reset = .true.
469  errmax = rzero
470 *
471  DO 110 im = 1, nidim
472  m = idim( im )
473 *
474  DO 100 in = 1, nidim
475  n = idim( in )
476 * Set LDC to 1 more than minimum value if room.
477  ldc = m
478  IF( ldc.LT.nmax )
479  $ ldc = ldc + 1
480 * Skip tests if not enough room.
481  IF( ldc.GT.nmax )
482  $ GO TO 100
483  lcc = ldc*n
484  null = n.LE.0.OR.m.LE.0
485 *
486  DO 90 ik = 1, nidim
487  k = idim( ik )
488 *
489  DO 80 ica = 1, 3
490  transa = ich( ica: ica )
491  trana = transa.EQ.'T'.OR.transa.EQ.'C'
492 *
493  IF( trana )THEN
494  ma = k
495  na = m
496  ELSE
497  ma = m
498  na = k
499  END IF
500 * Set LDA to 1 more than minimum value if room.
501  lda = ma
502  IF( lda.LT.nmax )
503  $ lda = lda + 1
504 * Skip tests if not enough room.
505  IF( lda.GT.nmax )
506  $ GO TO 80
507  laa = lda*na
508 *
509 * Generate the matrix A.
510 *
511  CALL zmake( 'GE', ' ', ' ', ma, na, a, nmax, aa, lda,
512  $ reset, zero )
513 *
514  DO 70 icb = 1, 3
515  transb = ich( icb: icb )
516  tranb = transb.EQ.'T'.OR.transb.EQ.'C'
517 *
518  IF( tranb )THEN
519  mb = n
520  nb = k
521  ELSE
522  mb = k
523  nb = n
524  END IF
525 * Set LDB to 1 more than minimum value if room.
526  ldb = mb
527  IF( ldb.LT.nmax )
528  $ ldb = ldb + 1
529 * Skip tests if not enough room.
530  IF( ldb.GT.nmax )
531  $ GO TO 70
532  lbb = ldb*nb
533 *
534 * Generate the matrix B.
535 *
536  CALL zmake( 'GE', ' ', ' ', mb, nb, b, nmax, bb,
537  $ ldb, reset, zero )
538 *
539  DO 60 ia = 1, nalf
540  alpha = alf( ia )
541 *
542  DO 50 ib = 1, nbet
543  beta = bet( ib )
544 *
545 * Generate the matrix C.
546 *
547  CALL zmake( 'GE', ' ', ' ', m, n, c, nmax,
548  $ cc, ldc, reset, zero )
549 *
550  nc = nc + 1
551 *
552 * Save every datum before calling the
553 * subroutine.
554 *
555  tranas = transa
556  tranbs = transb
557  ms = m
558  ns = n
559  ks = k
560  als = alpha
561  DO 10 i = 1, laa
562  as( i ) = aa( i )
563  10 CONTINUE
564  ldas = lda
565  DO 20 i = 1, lbb
566  bs( i ) = bb( i )
567  20 CONTINUE
568  ldbs = ldb
569  bls = beta
570  DO 30 i = 1, lcc
571  cs( i ) = cc( i )
572  30 CONTINUE
573  ldcs = ldc
574 *
575 * Call the subroutine.
576 *
577  IF( trace )
578  $ WRITE( ntra, fmt = 9995 )nc, sname,
579  $ transa, transb, m, n, k, alpha, lda, ldb,
580  $ beta, ldc
581  IF( rewi )
582  $ rewind ntra
583  CALL zgemm( transa, transb, m, n, k, alpha,
584  $ aa, lda, bb, ldb, beta, cc, ldc )
585 *
586 * Check if error-exit was taken incorrectly.
587 *
588  IF( .NOT.ok )THEN
589  WRITE( nout, fmt = 9994 )
590  fatal = .true.
591  GO TO 120
592  END IF
593 *
594 * See what data changed inside subroutines.
595 *
596  isame( 1 ) = transa.EQ.tranas
597  isame( 2 ) = transb.EQ.tranbs
598  isame( 3 ) = ms.EQ.m
599  isame( 4 ) = ns.EQ.n
600  isame( 5 ) = ks.EQ.k
601  isame( 6 ) = als.EQ.alpha
602  isame( 7 ) = lze( as, aa, laa )
603  isame( 8 ) = ldas.EQ.lda
604  isame( 9 ) = lze( bs, bb, lbb )
605  isame( 10 ) = ldbs.EQ.ldb
606  isame( 11 ) = bls.EQ.beta
607  IF( null )THEN
608  isame( 12 ) = lze( cs, cc, lcc )
609  ELSE
610  isame( 12 ) = lzeres( 'GE', ' ', m, n, cs,
611  $ cc, ldc )
612  END IF
613  isame( 13 ) = ldcs.EQ.ldc
614 *
615 * If data was incorrectly changed, report
616 * and return.
617 *
618  same = .true.
619  DO 40 i = 1, nargs
620  same = same.AND.isame( i )
621  IF( .NOT.isame( i ) )
622  $ WRITE( nout, fmt = 9998 )i
623  40 CONTINUE
624  IF( .NOT.same )THEN
625  fatal = .true.
626  GO TO 120
627  END IF
628 *
629  IF( .NOT.null )THEN
630 *
631 * Check the result.
632 *
633  CALL zmmch( transa, transb, m, n, k,
634  $ alpha, a, nmax, b, nmax, beta,
635  $ c, nmax, ct, g, cc, ldc, eps,
636  $ err, fatal, nout, .true. )
637  errmax = max( errmax, err )
638 * If got really bad answer, report and
639 * return.
640  IF( fatal )
641  $ GO TO 120
642  END IF
643 *
644  50 CONTINUE
645 *
646  60 CONTINUE
647 *
648  70 CONTINUE
649 *
650  80 CONTINUE
651 *
652  90 CONTINUE
653 *
654  100 CONTINUE
655 *
656  110 CONTINUE
657 *
658 * Report result.
659 *
660  IF( errmax.LT.thresh )THEN
661  WRITE( nout, fmt = 9999 )sname, nc
662  ELSE
663  WRITE( nout, fmt = 9997 )sname, nc, errmax
664  END IF
665  GO TO 130
666 *
667  120 CONTINUE
668  WRITE( nout, fmt = 9996 )sname
669  WRITE( nout, fmt = 9995 )nc, sname, transa, transb, m, n, k,
670  $ alpha, lda, ldb, beta, ldc
671 *
672  130 CONTINUE
673  RETURN
674 *
675  9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
676  $ 'S)' )
677  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
678  $ 'ANGED INCORRECTLY *******' )
679  9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
680  $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
681  $ ' - SUSPECT *******' )
682  9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
683  9995 FORMAT( 1x, i6, ': ', a6, '(''', a1, ''',''', a1, ''',',
684  $ 3( i3, ',' ), '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3,
685  $ ',(', f4.1, ',', f4.1, '), C,', i3, ').' )
686  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
687  $ '******' )
688 *
689 * End of ZCHK1.
690 *
691  END
692  SUBROUTINE zchk2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
693  $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
694  $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
695 *
696 * Tests ZHEMM and ZSYMM.
697 *
698 * Auxiliary routine for test program for Level 3 Blas.
699 *
700 * -- Written on 8-February-1989.
701 * Jack Dongarra, Argonne National Laboratory.
702 * Iain Duff, AERE Harwell.
703 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
704 * Sven Hammarling, Numerical Algorithms Group Ltd.
705 *
706 * .. Parameters ..
707  COMPLEX*16 ZERO
708  PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ) )
709  DOUBLE PRECISION RZERO
710  PARAMETER ( RZERO = 0.0d0 )
711 * .. Scalar Arguments ..
712  DOUBLE PRECISION EPS, THRESH
713  INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
714  LOGICAL FATAL, REWI, TRACE
715  CHARACTER*6 SNAME
716 * .. Array Arguments ..
717  COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
718  $ as( nmax*nmax ), b( nmax, nmax ),
719  $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
720  $ c( nmax, nmax ), cc( nmax*nmax ),
721  $ cs( nmax*nmax ), ct( nmax )
722  DOUBLE PRECISION G( NMAX )
723  INTEGER IDIM( NIDIM )
724 * .. Local Scalars ..
725  COMPLEX*16 ALPHA, ALS, BETA, BLS
726  DOUBLE PRECISION ERR, ERRMAX
727  INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
728  $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
729  $ nargs, nc, ns
730  LOGICAL CONJ, LEFT, NULL, RESET, SAME
731  CHARACTER*1 SIDE, SIDES, UPLO, UPLOS
732  CHARACTER*2 ICHS, ICHU
733 * .. Local Arrays ..
734  LOGICAL ISAME( 13 )
735 * .. External Functions ..
736  LOGICAL LZE, LZERES
737  EXTERNAL LZE, LZERES
738 * .. External Subroutines ..
739  EXTERNAL zhemm, zmake, zmmch, zsymm
740 * .. Intrinsic Functions ..
741  INTRINSIC max
742 * .. Scalars in Common ..
743  INTEGER INFOT, NOUTC
744  LOGICAL LERR, OK
745 * .. Common blocks ..
746  COMMON /infoc/infot, noutc, ok, lerr
747 * .. Data statements ..
748  DATA ichs/'LR'/, ichu/'UL'/
749 * .. Executable Statements ..
750  conj = sname( 2: 3 ).EQ.'HE'
751 *
752  nargs = 12
753  nc = 0
754  reset = .true.
755  errmax = rzero
756 *
757  DO 100 im = 1, nidim
758  m = idim( im )
759 *
760  DO 90 in = 1, nidim
761  n = idim( in )
762 * Set LDC to 1 more than minimum value if room.
763  ldc = m
764  IF( ldc.LT.nmax )
765  $ ldc = ldc + 1
766 * Skip tests if not enough room.
767  IF( ldc.GT.nmax )
768  $ GO TO 90
769  lcc = ldc*n
770  null = n.LE.0.OR.m.LE.0
771 * Set LDB to 1 more than minimum value if room.
772  ldb = m
773  IF( ldb.LT.nmax )
774  $ ldb = ldb + 1
775 * Skip tests if not enough room.
776  IF( ldb.GT.nmax )
777  $ GO TO 90
778  lbb = ldb*n
779 *
780 * Generate the matrix B.
781 *
782  CALL zmake( 'GE', ' ', ' ', m, n, b, nmax, bb, ldb, reset,
783  $ zero )
784 *
785  DO 80 ics = 1, 2
786  side = ichs( ics: ics )
787  left = side.EQ.'L'
788 *
789  IF( left )THEN
790  na = m
791  ELSE
792  na = n
793  END IF
794 * Set LDA to 1 more than minimum value if room.
795  lda = na
796  IF( lda.LT.nmax )
797  $ lda = lda + 1
798 * Skip tests if not enough room.
799  IF( lda.GT.nmax )
800  $ GO TO 80
801  laa = lda*na
802 *
803  DO 70 icu = 1, 2
804  uplo = ichu( icu: icu )
805 *
806 * Generate the hermitian or symmetric matrix A.
807 *
808  CALL zmake( sname( 2: 3 ), uplo, ' ', na, na, a, nmax,
809  $ aa, lda, reset, zero )
810 *
811  DO 60 ia = 1, nalf
812  alpha = alf( ia )
813 *
814  DO 50 ib = 1, nbet
815  beta = bet( ib )
816 *
817 * Generate the matrix C.
818 *
819  CALL zmake( 'GE', ' ', ' ', m, n, c, nmax, cc,
820  $ ldc, reset, zero )
821 *
822  nc = nc + 1
823 *
824 * Save every datum before calling the
825 * subroutine.
826 *
827  sides = side
828  uplos = uplo
829  ms = m
830  ns = n
831  als = alpha
832  DO 10 i = 1, laa
833  as( i ) = aa( i )
834  10 CONTINUE
835  ldas = lda
836  DO 20 i = 1, lbb
837  bs( i ) = bb( i )
838  20 CONTINUE
839  ldbs = ldb
840  bls = beta
841  DO 30 i = 1, lcc
842  cs( i ) = cc( i )
843  30 CONTINUE
844  ldcs = ldc
845 *
846 * Call the subroutine.
847 *
848  IF( trace )
849  $ WRITE( ntra, fmt = 9995 )nc, sname, side,
850  $ uplo, m, n, alpha, lda, ldb, beta, ldc
851  IF( rewi )
852  $ rewind ntra
853  IF( conj )THEN
854  CALL zhemm( side, uplo, m, n, alpha, aa, lda,
855  $ bb, ldb, beta, cc, ldc )
856  ELSE
857  CALL zsymm( side, uplo, m, n, alpha, aa, lda,
858  $ bb, ldb, beta, cc, ldc )
859  END IF
860 *
861 * Check if error-exit was taken incorrectly.
862 *
863  IF( .NOT.ok )THEN
864  WRITE( nout, fmt = 9994 )
865  fatal = .true.
866  GO TO 110
867  END IF
868 *
869 * See what data changed inside subroutines.
870 *
871  isame( 1 ) = sides.EQ.side
872  isame( 2 ) = uplos.EQ.uplo
873  isame( 3 ) = ms.EQ.m
874  isame( 4 ) = ns.EQ.n
875  isame( 5 ) = als.EQ.alpha
876  isame( 6 ) = lze( as, aa, laa )
877  isame( 7 ) = ldas.EQ.lda
878  isame( 8 ) = lze( bs, bb, lbb )
879  isame( 9 ) = ldbs.EQ.ldb
880  isame( 10 ) = bls.EQ.beta
881  IF( null )THEN
882  isame( 11 ) = lze( cs, cc, lcc )
883  ELSE
884  isame( 11 ) = lzeres( 'GE', ' ', m, n, cs,
885  $ cc, ldc )
886  END IF
887  isame( 12 ) = ldcs.EQ.ldc
888 *
889 * If data was incorrectly changed, report and
890 * return.
891 *
892  same = .true.
893  DO 40 i = 1, nargs
894  same = same.AND.isame( i )
895  IF( .NOT.isame( i ) )
896  $ WRITE( nout, fmt = 9998 )i
897  40 CONTINUE
898  IF( .NOT.same )THEN
899  fatal = .true.
900  GO TO 110
901  END IF
902 *
903  IF( .NOT.null )THEN
904 *
905 * Check the result.
906 *
907  IF( left )THEN
908  CALL zmmch( 'N', 'N', m, n, m, alpha, a,
909  $ nmax, b, nmax, beta, c, nmax,
910  $ ct, g, cc, ldc, eps, err,
911  $ fatal, nout, .true. )
912  ELSE
913  CALL zmmch( 'N', 'N', m, n, n, alpha, b,
914  $ nmax, a, nmax, beta, c, nmax,
915  $ ct, g, cc, ldc, eps, err,
916  $ fatal, nout, .true. )
917  END IF
918  errmax = max( errmax, err )
919 * If got really bad answer, report and
920 * return.
921  IF( fatal )
922  $ GO TO 110
923  END IF
924 *
925  50 CONTINUE
926 *
927  60 CONTINUE
928 *
929  70 CONTINUE
930 *
931  80 CONTINUE
932 *
933  90 CONTINUE
934 *
935  100 CONTINUE
936 *
937 * Report result.
938 *
939  IF( errmax.LT.thresh )THEN
940  WRITE( nout, fmt = 9999 )sname, nc
941  ELSE
942  WRITE( nout, fmt = 9997 )sname, nc, errmax
943  END IF
944  GO TO 120
945 *
946  110 CONTINUE
947  WRITE( nout, fmt = 9996 )sname
948  WRITE( nout, fmt = 9995 )nc, sname, side, uplo, m, n, alpha, lda,
949  $ ldb, beta, ldc
950 *
951  120 CONTINUE
952  RETURN
953 *
954  9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
955  $ 'S)' )
956  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
957  $ 'ANGED INCORRECTLY *******' )
958  9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
959  $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
960  $ ' - SUSPECT *******' )
961  9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
962  9995 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
963  $ '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ',(', f4.1,
964  $ ',', f4.1, '), C,', i3, ') .' )
965  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
966  $ '******' )
967 *
968 * End of ZCHK2.
969 *
970  END
971  SUBROUTINE zchk3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
972  $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
973  $ B, BB, BS, CT, G, C )
974 *
975 * Tests ZTRMM and ZTRSM.
976 *
977 * Auxiliary routine for test program for Level 3 Blas.
978 *
979 * -- Written on 8-February-1989.
980 * Jack Dongarra, Argonne National Laboratory.
981 * Iain Duff, AERE Harwell.
982 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
983 * Sven Hammarling, Numerical Algorithms Group Ltd.
984 *
985 * .. Parameters ..
986  COMPLEX*16 ZERO, ONE
987  PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ),
988  $ one = ( 1.0d0, 0.0d0 ) )
989  DOUBLE PRECISION RZERO
990  PARAMETER ( RZERO = 0.0d0 )
991 * .. Scalar Arguments ..
992  DOUBLE PRECISION EPS, THRESH
993  INTEGER NALF, NIDIM, NMAX, NOUT, NTRA
994  LOGICAL FATAL, REWI, TRACE
995  CHARACTER*6 SNAME
996 * .. Array Arguments ..
997  COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
998  $ as( nmax*nmax ), b( nmax, nmax ),
999  $ bb( nmax*nmax ), bs( nmax*nmax ),
1000  $ c( nmax, nmax ), ct( nmax )
1001  DOUBLE PRECISION G( NMAX )
1002  INTEGER IDIM( NIDIM )
1003 * .. Local Scalars ..
1004  COMPLEX*16 ALPHA, ALS
1005  DOUBLE PRECISION ERR, ERRMAX
1006  INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
1007  $ lda, ldas, ldb, ldbs, m, ms, n, na, nargs, nc,
1008  $ ns
1009  LOGICAL LEFT, NULL, RESET, SAME
1010  CHARACTER*1 DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
1011  $ uplos
1012  CHARACTER*2 ICHD, ICHS, ICHU
1013  CHARACTER*3 ICHT
1014 * .. Local Arrays ..
1015  LOGICAL ISAME( 13 )
1016 * .. External Functions ..
1017  LOGICAL LZE, LZERES
1018  EXTERNAL lze, lzeres
1019 * .. External Subroutines ..
1020  EXTERNAL zmake, zmmch, ztrmm, ztrsm
1021 * .. Intrinsic Functions ..
1022  INTRINSIC max
1023 * .. Scalars in Common ..
1024  INTEGER INFOT, NOUTC
1025  LOGICAL LERR, OK
1026 * .. Common blocks ..
1027  COMMON /infoc/infot, noutc, ok, lerr
1028 * .. Data statements ..
1029  DATA ichu/'UL'/, icht/'NTC'/, ichd/'UN'/, ichs/'LR'/
1030 * .. Executable Statements ..
1031 *
1032  nargs = 11
1033  nc = 0
1034  reset = .true.
1035  errmax = rzero
1036 * Set up zero matrix for ZMMCH.
1037  DO 20 j = 1, nmax
1038  DO 10 i = 1, nmax
1039  c( i, j ) = zero
1040  10 CONTINUE
1041  20 CONTINUE
1042 *
1043  DO 140 im = 1, nidim
1044  m = idim( im )
1045 *
1046  DO 130 in = 1, nidim
1047  n = idim( in )
1048 * Set LDB to 1 more than minimum value if room.
1049  ldb = m
1050  IF( ldb.LT.nmax )
1051  $ ldb = ldb + 1
1052 * Skip tests if not enough room.
1053  IF( ldb.GT.nmax )
1054  $ GO TO 130
1055  lbb = ldb*n
1056  null = m.LE.0.OR.n.LE.0
1057 *
1058  DO 120 ics = 1, 2
1059  side = ichs( ics: ics )
1060  left = side.EQ.'L'
1061  IF( left )THEN
1062  na = m
1063  ELSE
1064  na = n
1065  END IF
1066 * Set LDA to 1 more than minimum value if room.
1067  lda = na
1068  IF( lda.LT.nmax )
1069  $ lda = lda + 1
1070 * Skip tests if not enough room.
1071  IF( lda.GT.nmax )
1072  $ GO TO 130
1073  laa = lda*na
1074 *
1075  DO 110 icu = 1, 2
1076  uplo = ichu( icu: icu )
1077 *
1078  DO 100 ict = 1, 3
1079  transa = icht( ict: ict )
1080 *
1081  DO 90 icd = 1, 2
1082  diag = ichd( icd: icd )
1083 *
1084  DO 80 ia = 1, nalf
1085  alpha = alf( ia )
1086 *
1087 * Generate the matrix A.
1088 *
1089  CALL zmake( 'TR', uplo, diag, na, na, a,
1090  $ nmax, aa, lda, reset, zero )
1091 *
1092 * Generate the matrix B.
1093 *
1094  CALL zmake( 'GE', ' ', ' ', m, n, b, nmax,
1095  $ bb, ldb, reset, zero )
1096 *
1097  nc = nc + 1
1098 *
1099 * Save every datum before calling the
1100 * subroutine.
1101 *
1102  sides = side
1103  uplos = uplo
1104  tranas = transa
1105  diags = diag
1106  ms = m
1107  ns = n
1108  als = alpha
1109  DO 30 i = 1, laa
1110  as( i ) = aa( i )
1111  30 CONTINUE
1112  ldas = lda
1113  DO 40 i = 1, lbb
1114  bs( i ) = bb( i )
1115  40 CONTINUE
1116  ldbs = ldb
1117 *
1118 * Call the subroutine.
1119 *
1120  IF( sname( 4: 5 ).EQ.'MM' )THEN
1121  IF( trace )
1122  $ WRITE( ntra, fmt = 9995 )nc, sname,
1123  $ side, uplo, transa, diag, m, n, alpha,
1124  $ lda, ldb
1125  IF( rewi )
1126  $ rewind ntra
1127  CALL ztrmm( side, uplo, transa, diag, m,
1128  $ n, alpha, aa, lda, bb, ldb )
1129  ELSE IF( sname( 4: 5 ).EQ.'SM' )THEN
1130  IF( trace )
1131  $ WRITE( ntra, fmt = 9995 )nc, sname,
1132  $ side, uplo, transa, diag, m, n, alpha,
1133  $ lda, ldb
1134  IF( rewi )
1135  $ rewind ntra
1136  CALL ztrsm( side, uplo, transa, diag, m,
1137  $ n, alpha, aa, lda, bb, ldb )
1138  END IF
1139 *
1140 * Check if error-exit was taken incorrectly.
1141 *
1142  IF( .NOT.ok )THEN
1143  WRITE( nout, fmt = 9994 )
1144  fatal = .true.
1145  GO TO 150
1146  END IF
1147 *
1148 * See what data changed inside subroutines.
1149 *
1150  isame( 1 ) = sides.EQ.side
1151  isame( 2 ) = uplos.EQ.uplo
1152  isame( 3 ) = tranas.EQ.transa
1153  isame( 4 ) = diags.EQ.diag
1154  isame( 5 ) = ms.EQ.m
1155  isame( 6 ) = ns.EQ.n
1156  isame( 7 ) = als.EQ.alpha
1157  isame( 8 ) = lze( as, aa, laa )
1158  isame( 9 ) = ldas.EQ.lda
1159  IF( null )THEN
1160  isame( 10 ) = lze( bs, bb, lbb )
1161  ELSE
1162  isame( 10 ) = lzeres( 'GE', ' ', m, n, bs,
1163  $ bb, ldb )
1164  END IF
1165  isame( 11 ) = ldbs.EQ.ldb
1166 *
1167 * If data was incorrectly changed, report and
1168 * return.
1169 *
1170  same = .true.
1171  DO 50 i = 1, nargs
1172  same = same.AND.isame( i )
1173  IF( .NOT.isame( i ) )
1174  $ WRITE( nout, fmt = 9998 )i
1175  50 CONTINUE
1176  IF( .NOT.same )THEN
1177  fatal = .true.
1178  GO TO 150
1179  END IF
1180 *
1181  IF( .NOT.null )THEN
1182  IF( sname( 4: 5 ).EQ.'MM' )THEN
1183 *
1184 * Check the result.
1185 *
1186  IF( left )THEN
1187  CALL zmmch( transa, 'N', m, n, m,
1188  $ alpha, a, nmax, b, nmax,
1189  $ zero, c, nmax, ct, g,
1190  $ bb, ldb, eps, err,
1191  $ fatal, nout, .true. )
1192  ELSE
1193  CALL zmmch( 'N', transa, m, n, n,
1194  $ alpha, b, nmax, a, nmax,
1195  $ zero, c, nmax, ct, g,
1196  $ bb, ldb, eps, err,
1197  $ fatal, nout, .true. )
1198  END IF
1199  ELSE IF( sname( 4: 5 ).EQ.'SM' )THEN
1200 *
1201 * Compute approximation to original
1202 * matrix.
1203 *
1204  DO 70 j = 1, n
1205  DO 60 i = 1, m
1206  c( i, j ) = bb( i + ( j - 1 )*
1207  $ ldb )
1208  bb( i + ( j - 1 )*ldb ) = alpha*
1209  $ b( i, j )
1210  60 CONTINUE
1211  70 CONTINUE
1212 *
1213  IF( left )THEN
1214  CALL zmmch( transa, 'N', m, n, m,
1215  $ one, a, nmax, c, nmax,
1216  $ zero, b, nmax, ct, g,
1217  $ bb, ldb, eps, err,
1218  $ fatal, nout, .false. )
1219  ELSE
1220  CALL zmmch( 'N', transa, m, n, n,
1221  $ one, c, nmax, a, nmax,
1222  $ zero, b, nmax, ct, g,
1223  $ bb, ldb, eps, err,
1224  $ fatal, nout, .false. )
1225  END IF
1226  END IF
1227  errmax = max( errmax, err )
1228 * If got really bad answer, report and
1229 * return.
1230  IF( fatal )
1231  $ GO TO 150
1232  END IF
1233 *
1234  80 CONTINUE
1235 *
1236  90 CONTINUE
1237 *
1238  100 CONTINUE
1239 *
1240  110 CONTINUE
1241 *
1242  120 CONTINUE
1243 *
1244  130 CONTINUE
1245 *
1246  140 CONTINUE
1247 *
1248 * Report result.
1249 *
1250  IF( errmax.LT.thresh )THEN
1251  WRITE( nout, fmt = 9999 )sname, nc
1252  ELSE
1253  WRITE( nout, fmt = 9997 )sname, nc, errmax
1254  END IF
1255  GO TO 160
1256 *
1257  150 CONTINUE
1258  WRITE( nout, fmt = 9996 )sname
1259  WRITE( nout, fmt = 9995 )nc, sname, side, uplo, transa, diag, m,
1260  $ n, alpha, lda, ldb
1261 *
1262  160 CONTINUE
1263  RETURN
1264 *
1265  9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
1266  $ 'S)' )
1267  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
1268  $ 'ANGED INCORRECTLY *******' )
1269  9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
1270  $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1271  $ ' - SUSPECT *******' )
1272  9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
1273  9995 FORMAT( 1x, i6, ': ', a6, '(', 4( '''', a1, ''',' ), 2( i3, ',' ),
1274  $ '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ') ',
1275  $ ' .' )
1276  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1277  $ '******' )
1278 *
1279 * End of ZCHK3.
1280 *
1281  END
1282  SUBROUTINE zchk4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1283  $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
1284  $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
1285 *
1286 * Tests ZHERK and ZSYRK.
1287 *
1288 * Auxiliary routine for test program for Level 3 Blas.
1289 *
1290 * -- Written on 8-February-1989.
1291 * Jack Dongarra, Argonne National Laboratory.
1292 * Iain Duff, AERE Harwell.
1293 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
1294 * Sven Hammarling, Numerical Algorithms Group Ltd.
1295 *
1296 * .. Parameters ..
1297  COMPLEX*16 ZERO
1298  PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ) )
1299  DOUBLE PRECISION RONE, RZERO
1300  PARAMETER ( RONE = 1.0d0, rzero = 0.0d0 )
1301 * .. Scalar Arguments ..
1302  DOUBLE PRECISION EPS, THRESH
1303  INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
1304  LOGICAL FATAL, REWI, TRACE
1305  CHARACTER*6 SNAME
1306 * .. Array Arguments ..
1307  COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
1308  $ as( nmax*nmax ), b( nmax, nmax ),
1309  $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
1310  $ c( nmax, nmax ), cc( nmax*nmax ),
1311  $ cs( nmax*nmax ), ct( nmax )
1312  DOUBLE PRECISION G( NMAX )
1313  INTEGER IDIM( NIDIM )
1314 * .. Local Scalars ..
1315  COMPLEX*16 ALPHA, ALS, BETA, BETS
1316  DOUBLE PRECISION ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
1317  INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
1318  $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
1319  $ NARGS, NC, NS
1320  LOGICAL CONJ, NULL, RESET, SAME, TRAN, UPPER
1321  CHARACTER*1 TRANS, TRANSS, TRANST, UPLO, UPLOS
1322  CHARACTER*2 ICHT, ICHU
1323 * .. Local Arrays ..
1324  LOGICAL ISAME( 13 )
1325 * .. External Functions ..
1326  LOGICAL LZE, LZERES
1327  EXTERNAL LZE, LZERES
1328 * .. External Subroutines ..
1329  EXTERNAL zherk, zmake, zmmch, zsyrk
1330 * .. Intrinsic Functions ..
1331  INTRINSIC dcmplx, max, dble
1332 * .. Scalars in Common ..
1333  INTEGER INFOT, NOUTC
1334  LOGICAL LERR, OK
1335 * .. Common blocks ..
1336  COMMON /infoc/infot, noutc, ok, lerr
1337 * .. Data statements ..
1338  DATA icht/'NC'/, ichu/'UL'/
1339 * .. Executable Statements ..
1340  conj = sname( 2: 3 ).EQ.'HE'
1341 *
1342  nargs = 10
1343  nc = 0
1344  reset = .true.
1345  errmax = rzero
1346 *
1347  DO 100 in = 1, nidim
1348  n = idim( in )
1349 * Set LDC to 1 more than minimum value if room.
1350  ldc = n
1351  IF( ldc.LT.nmax )
1352  $ ldc = ldc + 1
1353 * Skip tests if not enough room.
1354  IF( ldc.GT.nmax )
1355  $ GO TO 100
1356  lcc = ldc*n
1357 *
1358  DO 90 ik = 1, nidim
1359  k = idim( ik )
1360 *
1361  DO 80 ict = 1, 2
1362  trans = icht( ict: ict )
1363  tran = trans.EQ.'C'
1364  IF( tran.AND..NOT.conj )
1365  $ trans = 'T'
1366  IF( tran )THEN
1367  ma = k
1368  na = n
1369  ELSE
1370  ma = n
1371  na = k
1372  END IF
1373 * Set LDA to 1 more than minimum value if room.
1374  lda = ma
1375  IF( lda.LT.nmax )
1376  $ lda = lda + 1
1377 * Skip tests if not enough room.
1378  IF( lda.GT.nmax )
1379  $ GO TO 80
1380  laa = lda*na
1381 *
1382 * Generate the matrix A.
1383 *
1384  CALL zmake( 'GE', ' ', ' ', ma, na, a, nmax, aa, lda,
1385  $ reset, zero )
1386 *
1387  DO 70 icu = 1, 2
1388  uplo = ichu( icu: icu )
1389  upper = uplo.EQ.'U'
1390 *
1391  DO 60 ia = 1, nalf
1392  alpha = alf( ia )
1393  IF( conj )THEN
1394  ralpha = dble( alpha )
1395  alpha = dcmplx( ralpha, rzero )
1396  END IF
1397 *
1398  DO 50 ib = 1, nbet
1399  beta = bet( ib )
1400  IF( conj )THEN
1401  rbeta = dble( beta )
1402  beta = dcmplx( rbeta, rzero )
1403  END IF
1404  null = n.LE.0
1405  IF( conj )
1406  $ null = null.OR.( ( k.LE.0.OR.ralpha.EQ.
1407  $ rzero ).AND.rbeta.EQ.rone )
1408 *
1409 * Generate the matrix C.
1410 *
1411  CALL zmake( sname( 2: 3 ), uplo, ' ', n, n, c,
1412  $ nmax, cc, ldc, reset, zero )
1413 *
1414  nc = nc + 1
1415 *
1416 * Save every datum before calling the subroutine.
1417 *
1418  uplos = uplo
1419  transs = trans
1420  ns = n
1421  ks = k
1422  IF( conj )THEN
1423  rals = ralpha
1424  ELSE
1425  als = alpha
1426  END IF
1427  DO 10 i = 1, laa
1428  as( i ) = aa( i )
1429  10 CONTINUE
1430  ldas = lda
1431  IF( conj )THEN
1432  rbets = rbeta
1433  ELSE
1434  bets = beta
1435  END IF
1436  DO 20 i = 1, lcc
1437  cs( i ) = cc( i )
1438  20 CONTINUE
1439  ldcs = ldc
1440 *
1441 * Call the subroutine.
1442 *
1443  IF( conj )THEN
1444  IF( trace )
1445  $ WRITE( ntra, fmt = 9994 )nc, sname, uplo,
1446  $ trans, n, k, ralpha, lda, rbeta, ldc
1447  IF( rewi )
1448  $ rewind ntra
1449  CALL zherk( uplo, trans, n, k, ralpha, aa,
1450  $ lda, rbeta, cc, ldc )
1451  ELSE
1452  IF( trace )
1453  $ WRITE( ntra, fmt = 9993 )nc, sname, uplo,
1454  $ trans, n, k, alpha, lda, beta, ldc
1455  IF( rewi )
1456  $ rewind ntra
1457  CALL zsyrk( uplo, trans, n, k, alpha, aa,
1458  $ lda, beta, cc, ldc )
1459  END IF
1460 *
1461 * Check if error-exit was taken incorrectly.
1462 *
1463  IF( .NOT.ok )THEN
1464  WRITE( nout, fmt = 9992 )
1465  fatal = .true.
1466  GO TO 120
1467  END IF
1468 *
1469 * See what data changed inside subroutines.
1470 *
1471  isame( 1 ) = uplos.EQ.uplo
1472  isame( 2 ) = transs.EQ.trans
1473  isame( 3 ) = ns.EQ.n
1474  isame( 4 ) = ks.EQ.k
1475  IF( conj )THEN
1476  isame( 5 ) = rals.EQ.ralpha
1477  ELSE
1478  isame( 5 ) = als.EQ.alpha
1479  END IF
1480  isame( 6 ) = lze( as, aa, laa )
1481  isame( 7 ) = ldas.EQ.lda
1482  IF( conj )THEN
1483  isame( 8 ) = rbets.EQ.rbeta
1484  ELSE
1485  isame( 8 ) = bets.EQ.beta
1486  END IF
1487  IF( null )THEN
1488  isame( 9 ) = lze( cs, cc, lcc )
1489  ELSE
1490  isame( 9 ) = lzeres( sname( 2: 3 ), uplo, n,
1491  $ n, cs, cc, ldc )
1492  END IF
1493  isame( 10 ) = ldcs.EQ.ldc
1494 *
1495 * If data was incorrectly changed, report and
1496 * return.
1497 *
1498  same = .true.
1499  DO 30 i = 1, nargs
1500  same = same.AND.isame( i )
1501  IF( .NOT.isame( i ) )
1502  $ WRITE( nout, fmt = 9998 )i
1503  30 CONTINUE
1504  IF( .NOT.same )THEN
1505  fatal = .true.
1506  GO TO 120
1507  END IF
1508 *
1509  IF( .NOT.null )THEN
1510 *
1511 * Check the result column by column.
1512 *
1513  IF( conj )THEN
1514  transt = 'C'
1515  ELSE
1516  transt = 'T'
1517  END IF
1518  jc = 1
1519  DO 40 j = 1, n
1520  IF( upper )THEN
1521  jj = 1
1522  lj = j
1523  ELSE
1524  jj = j
1525  lj = n - j + 1
1526  END IF
1527  IF( tran )THEN
1528  CALL zmmch( transt, 'N', lj, 1, k,
1529  $ alpha, a( 1, jj ), nmax,
1530  $ a( 1, j ), nmax, beta,
1531  $ c( jj, j ), nmax, ct, g,
1532  $ cc( jc ), ldc, eps, err,
1533  $ fatal, nout, .true. )
1534  ELSE
1535  CALL zmmch( 'N', transt, lj, 1, k,
1536  $ alpha, a( jj, 1 ), nmax,
1537  $ a( j, 1 ), nmax, beta,
1538  $ c( jj, j ), nmax, ct, g,
1539  $ cc( jc ), ldc, eps, err,
1540  $ fatal, nout, .true. )
1541  END IF
1542  IF( upper )THEN
1543  jc = jc + ldc
1544  ELSE
1545  jc = jc + ldc + 1
1546  END IF
1547  errmax = max( errmax, err )
1548 * If got really bad answer, report and
1549 * return.
1550  IF( fatal )
1551  $ GO TO 110
1552  40 CONTINUE
1553  END IF
1554 *
1555  50 CONTINUE
1556 *
1557  60 CONTINUE
1558 *
1559  70 CONTINUE
1560 *
1561  80 CONTINUE
1562 *
1563  90 CONTINUE
1564 *
1565  100 CONTINUE
1566 *
1567 * Report result.
1568 *
1569  IF( errmax.LT.thresh )THEN
1570  WRITE( nout, fmt = 9999 )sname, nc
1571  ELSE
1572  WRITE( nout, fmt = 9997 )sname, nc, errmax
1573  END IF
1574  GO TO 130
1575 *
1576  110 CONTINUE
1577  IF( n.GT.1 )
1578  $ WRITE( nout, fmt = 9995 )j
1579 *
1580  120 CONTINUE
1581  WRITE( nout, fmt = 9996 )sname
1582  IF( conj )THEN
1583  WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, ralpha,
1584  $ lda, rbeta, ldc
1585  ELSE
1586  WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, n, k, alpha,
1587  $ lda, beta, ldc
1588  END IF
1589 *
1590  130 CONTINUE
1591  RETURN
1592 *
1593  9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
1594  $ 'S)' )
1595  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
1596  $ 'ANGED INCORRECTLY *******' )
1597  9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
1598  $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1599  $ ' - SUSPECT *******' )
1600  9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
1601  9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1602  9994 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
1603  $ f4.1, ', A,', i3, ',', f4.1, ', C,', i3, ') ',
1604  $ ' .' )
1605  9993 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
1606  $ '(', f4.1, ',', f4.1, ') , A,', i3, ',(', f4.1, ',', f4.1,
1607  $ '), C,', i3, ') .' )
1608  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1609  $ '******' )
1610 *
1611 * End of ZCHK4.
1612 *
1613  END
1614  SUBROUTINE zchk5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1615  $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
1616  $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
1617 *
1618 * Tests ZHER2K and ZSYR2K.
1619 *
1620 * Auxiliary routine for test program for Level 3 Blas.
1621 *
1622 * -- Written on 8-February-1989.
1623 * Jack Dongarra, Argonne National Laboratory.
1624 * Iain Duff, AERE Harwell.
1625 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
1626 * Sven Hammarling, Numerical Algorithms Group Ltd.
1627 *
1628 * .. Parameters ..
1629  COMPLEX*16 ZERO, ONE
1630  PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ),
1631  $ one = ( 1.0d0, 0.0d0 ) )
1632  DOUBLE PRECISION RONE, RZERO
1633  PARAMETER ( RONE = 1.0d0, rzero = 0.0d0 )
1634 * .. Scalar Arguments ..
1635  DOUBLE PRECISION EPS, THRESH
1636  INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA
1637  LOGICAL FATAL, REWI, TRACE
1638  CHARACTER*6 SNAME
1639 * .. Array Arguments ..
1640  COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
1641  $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
1642  $ bet( nbet ), bs( nmax*nmax ), c( nmax, nmax ),
1643  $ cc( nmax*nmax ), cs( nmax*nmax ), ct( nmax ),
1644  $ w( 2*nmax )
1645  DOUBLE PRECISION G( NMAX )
1646  INTEGER IDIM( NIDIM )
1647 * .. Local Scalars ..
1648  COMPLEX*16 ALPHA, ALS, BETA, BETS
1649  DOUBLE PRECISION ERR, ERRMAX, RBETA, RBETS
1650  INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
1651  $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
1652  $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
1653  LOGICAL CONJ, NULL, RESET, SAME, TRAN, UPPER
1654  CHARACTER*1 TRANS, TRANSS, TRANST, UPLO, UPLOS
1655  CHARACTER*2 ICHT, ICHU
1656 * .. Local Arrays ..
1657  LOGICAL ISAME( 13 )
1658 * .. External Functions ..
1659  LOGICAL LZE, LZERES
1660  EXTERNAL lze, lzeres
1661 * .. External Subroutines ..
1662  EXTERNAL zher2k, zmake, zmmch, zsyr2k
1663 * .. Intrinsic Functions ..
1664  INTRINSIC dcmplx, dconjg, max, dble
1665 * .. Scalars in Common ..
1666  INTEGER INFOT, NOUTC
1667  LOGICAL LERR, OK
1668 * .. Common blocks ..
1669  COMMON /infoc/infot, noutc, ok, lerr
1670 * .. Data statements ..
1671  DATA icht/'NC'/, ichu/'UL'/
1672 * .. Executable Statements ..
1673  conj = sname( 2: 3 ).EQ.'HE'
1674 *
1675  nargs = 12
1676  nc = 0
1677  reset = .true.
1678  errmax = rzero
1679 *
1680  DO 130 in = 1, nidim
1681  n = idim( in )
1682 * Set LDC to 1 more than minimum value if room.
1683  ldc = n
1684  IF( ldc.LT.nmax )
1685  $ ldc = ldc + 1
1686 * Skip tests if not enough room.
1687  IF( ldc.GT.nmax )
1688  $ GO TO 130
1689  lcc = ldc*n
1690 *
1691  DO 120 ik = 1, nidim
1692  k = idim( ik )
1693 *
1694  DO 110 ict = 1, 2
1695  trans = icht( ict: ict )
1696  tran = trans.EQ.'C'
1697  IF( tran.AND..NOT.conj )
1698  $ trans = 'T'
1699  IF( tran )THEN
1700  ma = k
1701  na = n
1702  ELSE
1703  ma = n
1704  na = k
1705  END IF
1706 * Set LDA to 1 more than minimum value if room.
1707  lda = ma
1708  IF( lda.LT.nmax )
1709  $ lda = lda + 1
1710 * Skip tests if not enough room.
1711  IF( lda.GT.nmax )
1712  $ GO TO 110
1713  laa = lda*na
1714 *
1715 * Generate the matrix A.
1716 *
1717  IF( tran )THEN
1718  CALL zmake( 'GE', ' ', ' ', ma, na, ab, 2*nmax, aa,
1719  $ lda, reset, zero )
1720  ELSE
1721  CALL zmake( 'GE', ' ', ' ', ma, na, ab, nmax, aa, lda,
1722  $ reset, zero )
1723  END IF
1724 *
1725 * Generate the matrix B.
1726 *
1727  ldb = lda
1728  lbb = laa
1729  IF( tran )THEN
1730  CALL zmake( 'GE', ' ', ' ', ma, na, ab( k + 1 ),
1731  $ 2*nmax, bb, ldb, reset, zero )
1732  ELSE
1733  CALL zmake( 'GE', ' ', ' ', ma, na, ab( k*nmax + 1 ),
1734  $ nmax, bb, ldb, reset, zero )
1735  END IF
1736 *
1737  DO 100 icu = 1, 2
1738  uplo = ichu( icu: icu )
1739  upper = uplo.EQ.'U'
1740 *
1741  DO 90 ia = 1, nalf
1742  alpha = alf( ia )
1743 *
1744  DO 80 ib = 1, nbet
1745  beta = bet( ib )
1746  IF( conj )THEN
1747  rbeta = dble( beta )
1748  beta = dcmplx( rbeta, rzero )
1749  END IF
1750  null = n.LE.0
1751  IF( conj )
1752  $ null = null.OR.( ( k.LE.0.OR.alpha.EQ.
1753  $ zero ).AND.rbeta.EQ.rone )
1754 *
1755 * Generate the matrix C.
1756 *
1757  CALL zmake( sname( 2: 3 ), uplo, ' ', n, n, c,
1758  $ nmax, cc, ldc, reset, zero )
1759 *
1760  nc = nc + 1
1761 *
1762 * Save every datum before calling the subroutine.
1763 *
1764  uplos = uplo
1765  transs = trans
1766  ns = n
1767  ks = k
1768  als = alpha
1769  DO 10 i = 1, laa
1770  as( i ) = aa( i )
1771  10 CONTINUE
1772  ldas = lda
1773  DO 20 i = 1, lbb
1774  bs( i ) = bb( i )
1775  20 CONTINUE
1776  ldbs = ldb
1777  IF( conj )THEN
1778  rbets = rbeta
1779  ELSE
1780  bets = beta
1781  END IF
1782  DO 30 i = 1, lcc
1783  cs( i ) = cc( i )
1784  30 CONTINUE
1785  ldcs = ldc
1786 *
1787 * Call the subroutine.
1788 *
1789  IF( conj )THEN
1790  IF( trace )
1791  $ WRITE( ntra, fmt = 9994 )nc, sname, uplo,
1792  $ trans, n, k, alpha, lda, ldb, rbeta, ldc
1793  IF( rewi )
1794  $ rewind ntra
1795  CALL zher2k( uplo, trans, n, k, alpha, aa,
1796  $ lda, bb, ldb, rbeta, cc, ldc )
1797  ELSE
1798  IF( trace )
1799  $ WRITE( ntra, fmt = 9993 )nc, sname, uplo,
1800  $ trans, n, k, alpha, lda, ldb, beta, ldc
1801  IF( rewi )
1802  $ rewind ntra
1803  CALL zsyr2k( uplo, trans, n, k, alpha, aa,
1804  $ lda, bb, ldb, beta, cc, ldc )
1805  END IF
1806 *
1807 * Check if error-exit was taken incorrectly.
1808 *
1809  IF( .NOT.ok )THEN
1810  WRITE( nout, fmt = 9992 )
1811  fatal = .true.
1812  GO TO 150
1813  END IF
1814 *
1815 * See what data changed inside subroutines.
1816 *
1817  isame( 1 ) = uplos.EQ.uplo
1818  isame( 2 ) = transs.EQ.trans
1819  isame( 3 ) = ns.EQ.n
1820  isame( 4 ) = ks.EQ.k
1821  isame( 5 ) = als.EQ.alpha
1822  isame( 6 ) = lze( as, aa, laa )
1823  isame( 7 ) = ldas.EQ.lda
1824  isame( 8 ) = lze( bs, bb, lbb )
1825  isame( 9 ) = ldbs.EQ.ldb
1826  IF( conj )THEN
1827  isame( 10 ) = rbets.EQ.rbeta
1828  ELSE
1829  isame( 10 ) = bets.EQ.beta
1830  END IF
1831  IF( null )THEN
1832  isame( 11 ) = lze( cs, cc, lcc )
1833  ELSE
1834  isame( 11 ) = lzeres( 'HE', uplo, n, n, cs,
1835  $ cc, ldc )
1836  END IF
1837  isame( 12 ) = ldcs.EQ.ldc
1838 *
1839 * If data was incorrectly changed, report and
1840 * return.
1841 *
1842  same = .true.
1843  DO 40 i = 1, nargs
1844  same = same.AND.isame( i )
1845  IF( .NOT.isame( i ) )
1846  $ WRITE( nout, fmt = 9998 )i
1847  40 CONTINUE
1848  IF( .NOT.same )THEN
1849  fatal = .true.
1850  GO TO 150
1851  END IF
1852 *
1853  IF( .NOT.null )THEN
1854 *
1855 * Check the result column by column.
1856 *
1857  IF( conj )THEN
1858  transt = 'C'
1859  ELSE
1860  transt = 'T'
1861  END IF
1862  jjab = 1
1863  jc = 1
1864  DO 70 j = 1, n
1865  IF( upper )THEN
1866  jj = 1
1867  lj = j
1868  ELSE
1869  jj = j
1870  lj = n - j + 1
1871  END IF
1872  IF( tran )THEN
1873  DO 50 i = 1, k
1874  w( i ) = alpha*ab( ( j - 1 )*2*
1875  $ nmax + k + i )
1876  IF( conj )THEN
1877  w( k + i ) = dconjg( alpha )*
1878  $ ab( ( j - 1 )*2*
1879  $ nmax + i )
1880  ELSE
1881  w( k + i ) = alpha*
1882  $ ab( ( j - 1 )*2*
1883  $ nmax + i )
1884  END IF
1885  50 CONTINUE
1886  CALL zmmch( transt, 'N', lj, 1, 2*k,
1887  $ one, ab( jjab ), 2*nmax, w,
1888  $ 2*nmax, beta, c( jj, j ),
1889  $ nmax, ct, g, cc( jc ), ldc,
1890  $ eps, err, fatal, nout,
1891  $ .true. )
1892  ELSE
1893  DO 60 i = 1, k
1894  IF( conj )THEN
1895  w( i ) = alpha*dconjg( ab( ( k +
1896  $ i - 1 )*nmax + j ) )
1897  w( k + i ) = dconjg( alpha*
1898  $ ab( ( i - 1 )*nmax +
1899  $ j ) )
1900  ELSE
1901  w( i ) = alpha*ab( ( k + i - 1 )*
1902  $ nmax + j )
1903  w( k + i ) = alpha*
1904  $ ab( ( i - 1 )*nmax +
1905  $ j )
1906  END IF
1907  60 CONTINUE
1908  CALL zmmch( 'N', 'N', lj, 1, 2*k, one,
1909  $ ab( jj ), nmax, w, 2*nmax,
1910  $ beta, c( jj, j ), nmax, ct,
1911  $ g, cc( jc ), ldc, eps, err,
1912  $ fatal, nout, .true. )
1913  END IF
1914  IF( upper )THEN
1915  jc = jc + ldc
1916  ELSE
1917  jc = jc + ldc + 1
1918  IF( tran )
1919  $ jjab = jjab + 2*nmax
1920  END IF
1921  errmax = max( errmax, err )
1922 * If got really bad answer, report and
1923 * return.
1924  IF( fatal )
1925  $ GO TO 140
1926  70 CONTINUE
1927  END IF
1928 *
1929  80 CONTINUE
1930 *
1931  90 CONTINUE
1932 *
1933  100 CONTINUE
1934 *
1935  110 CONTINUE
1936 *
1937  120 CONTINUE
1938 *
1939  130 CONTINUE
1940 *
1941 * Report result.
1942 *
1943  IF( errmax.LT.thresh )THEN
1944  WRITE( nout, fmt = 9999 )sname, nc
1945  ELSE
1946  WRITE( nout, fmt = 9997 )sname, nc, errmax
1947  END IF
1948  GO TO 160
1949 *
1950  140 CONTINUE
1951  IF( n.GT.1 )
1952  $ WRITE( nout, fmt = 9995 )j
1953 *
1954  150 CONTINUE
1955  WRITE( nout, fmt = 9996 )sname
1956  IF( conj )THEN
1957  WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, alpha,
1958  $ lda, ldb, rbeta, ldc
1959  ELSE
1960  WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, n, k, alpha,
1961  $ lda, ldb, beta, ldc
1962  END IF
1963 *
1964  160 CONTINUE
1965  RETURN
1966 *
1967  9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
1968  $ 'S)' )
1969  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
1970  $ 'ANGED INCORRECTLY *******' )
1971  9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
1972  $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1973  $ ' - SUSPECT *******' )
1974  9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
1975  9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1976  9994 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
1977  $ '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ',', f4.1,
1978  $ ', C,', i3, ') .' )
1979  9993 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
1980  $ '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ',(', f4.1,
1981  $ ',', f4.1, '), C,', i3, ') .' )
1982  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1983  $ '******' )
1984 *
1985 * End of ZCHK5.
1986 *
1987  END
1988  SUBROUTINE zchke( ISNUM, SRNAMT, NOUT )
1989 *
1990 * Tests the error exits from the Level 3 Blas.
1991 * Requires a special version of the error-handling routine XERBLA.
1992 * A, B and C should not need to be defined.
1993 *
1994 * Auxiliary routine for test program for Level 3 Blas.
1995 *
1996 * -- Written on 8-February-1989.
1997 * Jack Dongarra, Argonne National Laboratory.
1998 * Iain Duff, AERE Harwell.
1999 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
2000 * Sven Hammarling, Numerical Algorithms Group Ltd.
2001 *
2002 * 3-19-92: Initialize ALPHA, BETA, RALPHA, and RBETA (eca)
2003 * 3-19-92: Fix argument 12 in calls to ZSYMM and ZHEMM
2004 * with INFOT = 9 (eca)
2005 * 10-9-00: Declared INTRINSIC DCMPLX (susan)
2006 *
2007 * .. Scalar Arguments ..
2008  INTEGER ISNUM, NOUT
2009  CHARACTER*6 SRNAMT
2010 * .. Scalars in Common ..
2011  INTEGER INFOT, NOUTC
2012  LOGICAL LERR, OK
2013 * .. Parameters ..
2014  REAL ONE, TWO
2015  PARAMETER ( ONE = 1.0d0, two = 2.0d0 )
2016 * .. Local Scalars ..
2017  COMPLEX*16 ALPHA, BETA
2018  DOUBLE PRECISION RALPHA, RBETA
2019 * .. Local Arrays ..
2020  COMPLEX*16 A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
2021 * .. External Subroutines ..
2022  EXTERNAL zgemm, zhemm, zher2k, zherk, chkxer, zsymm,
2023  $ zsyr2k, zsyrk, ztrmm, ztrsm
2024 * .. Intrinsic Functions ..
2025  INTRINSIC dcmplx
2026 * .. Common blocks ..
2027  COMMON /infoc/infot, noutc, ok, lerr
2028 * .. Executable Statements ..
2029 * OK is set to .FALSE. by the special version of XERBLA or by CHKXER
2030 * if anything is wrong.
2031  ok = .true.
2032 * LERR is set to .TRUE. by the special version of XERBLA each time
2033 * it is called, and is then tested and re-set by CHKXER.
2034  lerr = .false.
2035 *
2036 * Initialize ALPHA, BETA, RALPHA, and RBETA.
2037 *
2038  alpha = dcmplx( one, -one )
2039  beta = dcmplx( two, -two )
2040  ralpha = one
2041  rbeta = two
2042 *
2043  GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
2044  $ 90 )isnum
2045  10 infot = 1
2046  CALL zgemm( '/', 'N', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2047  CALL chkxer( srnamt, infot, nout, lerr, ok )
2048  infot = 1
2049  CALL zgemm( '/', 'C', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2050  CALL chkxer( srnamt, infot, nout, lerr, ok )
2051  infot = 1
2052  CALL zgemm( '/', 'T', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2053  CALL chkxer( srnamt, infot, nout, lerr, ok )
2054  infot = 2
2055  CALL zgemm( 'N', '/', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2056  CALL chkxer( srnamt, infot, nout, lerr, ok )
2057  infot = 2
2058  CALL zgemm( 'C', '/', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2059  CALL chkxer( srnamt, infot, nout, lerr, ok )
2060  infot = 2
2061  CALL zgemm( 'T', '/', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2062  CALL chkxer( srnamt, infot, nout, lerr, ok )
2063  infot = 3
2064  CALL zgemm( 'N', 'N', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2065  CALL chkxer( srnamt, infot, nout, lerr, ok )
2066  infot = 3
2067  CALL zgemm( 'N', 'C', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2068  CALL chkxer( srnamt, infot, nout, lerr, ok )
2069  infot = 3
2070  CALL zgemm( 'N', 'T', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2071  CALL chkxer( srnamt, infot, nout, lerr, ok )
2072  infot = 3
2073  CALL zgemm( 'C', 'N', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2074  CALL chkxer( srnamt, infot, nout, lerr, ok )
2075  infot = 3
2076  CALL zgemm( 'C', 'C', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2077  CALL chkxer( srnamt, infot, nout, lerr, ok )
2078  infot = 3
2079  CALL zgemm( 'C', 'T', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2080  CALL chkxer( srnamt, infot, nout, lerr, ok )
2081  infot = 3
2082  CALL zgemm( 'T', 'N', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2083  CALL chkxer( srnamt, infot, nout, lerr, ok )
2084  infot = 3
2085  CALL zgemm( 'T', 'C', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2086  CALL chkxer( srnamt, infot, nout, lerr, ok )
2087  infot = 3
2088  CALL zgemm( 'T', 'T', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2089  CALL chkxer( srnamt, infot, nout, lerr, ok )
2090  infot = 4
2091  CALL zgemm( 'N', 'N', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2092  CALL chkxer( srnamt, infot, nout, lerr, ok )
2093  infot = 4
2094  CALL zgemm( 'N', 'C', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2095  CALL chkxer( srnamt, infot, nout, lerr, ok )
2096  infot = 4
2097  CALL zgemm( 'N', 'T', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2098  CALL chkxer( srnamt, infot, nout, lerr, ok )
2099  infot = 4
2100  CALL zgemm( 'C', 'N', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2101  CALL chkxer( srnamt, infot, nout, lerr, ok )
2102  infot = 4
2103  CALL zgemm( 'C', 'C', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2104  CALL chkxer( srnamt, infot, nout, lerr, ok )
2105  infot = 4
2106  CALL zgemm( 'C', 'T', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2107  CALL chkxer( srnamt, infot, nout, lerr, ok )
2108  infot = 4
2109  CALL zgemm( 'T', 'N', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2110  CALL chkxer( srnamt, infot, nout, lerr, ok )
2111  infot = 4
2112  CALL zgemm( 'T', 'C', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2113  CALL chkxer( srnamt, infot, nout, lerr, ok )
2114  infot = 4
2115  CALL zgemm( 'T', 'T', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2116  CALL chkxer( srnamt, infot, nout, lerr, ok )
2117  infot = 5
2118  CALL zgemm( 'N', 'N', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2119  CALL chkxer( srnamt, infot, nout, lerr, ok )
2120  infot = 5
2121  CALL zgemm( 'N', 'C', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2122  CALL chkxer( srnamt, infot, nout, lerr, ok )
2123  infot = 5
2124  CALL zgemm( 'N', 'T', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2125  CALL chkxer( srnamt, infot, nout, lerr, ok )
2126  infot = 5
2127  CALL zgemm( 'C', 'N', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2128  CALL chkxer( srnamt, infot, nout, lerr, ok )
2129  infot = 5
2130  CALL zgemm( 'C', 'C', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2131  CALL chkxer( srnamt, infot, nout, lerr, ok )
2132  infot = 5
2133  CALL zgemm( 'C', 'T', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2134  CALL chkxer( srnamt, infot, nout, lerr, ok )
2135  infot = 5
2136  CALL zgemm( 'T', 'N', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2137  CALL chkxer( srnamt, infot, nout, lerr, ok )
2138  infot = 5
2139  CALL zgemm( 'T', 'C', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2140  CALL chkxer( srnamt, infot, nout, lerr, ok )
2141  infot = 5
2142  CALL zgemm( 'T', 'T', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2143  CALL chkxer( srnamt, infot, nout, lerr, ok )
2144  infot = 8
2145  CALL zgemm( 'N', 'N', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 2 )
2146  CALL chkxer( srnamt, infot, nout, lerr, ok )
2147  infot = 8
2148  CALL zgemm( 'N', 'C', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 2 )
2149  CALL chkxer( srnamt, infot, nout, lerr, ok )
2150  infot = 8
2151  CALL zgemm( 'N', 'T', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 2 )
2152  CALL chkxer( srnamt, infot, nout, lerr, ok )
2153  infot = 8
2154  CALL zgemm( 'C', 'N', 0, 0, 2, alpha, a, 1, b, 2, beta, c, 1 )
2155  CALL chkxer( srnamt, infot, nout, lerr, ok )
2156  infot = 8
2157  CALL zgemm( 'C', 'C', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2158  CALL chkxer( srnamt, infot, nout, lerr, ok )
2159  infot = 8
2160  CALL zgemm( 'C', 'T', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2161  CALL chkxer( srnamt, infot, nout, lerr, ok )
2162  infot = 8
2163  CALL zgemm( 'T', 'N', 0, 0, 2, alpha, a, 1, b, 2, beta, c, 1 )
2164  CALL chkxer( srnamt, infot, nout, lerr, ok )
2165  infot = 8
2166  CALL zgemm( 'T', 'C', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2167  CALL chkxer( srnamt, infot, nout, lerr, ok )
2168  infot = 8
2169  CALL zgemm( 'T', 'T', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2170  CALL chkxer( srnamt, infot, nout, lerr, ok )
2171  infot = 10
2172  CALL zgemm( 'N', 'N', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2173  CALL chkxer( srnamt, infot, nout, lerr, ok )
2174  infot = 10
2175  CALL zgemm( 'C', 'N', 0, 0, 2, alpha, a, 2, b, 1, beta, c, 1 )
2176  CALL chkxer( srnamt, infot, nout, lerr, ok )
2177  infot = 10
2178  CALL zgemm( 'T', 'N', 0, 0, 2, alpha, a, 2, b, 1, beta, c, 1 )
2179  CALL chkxer( srnamt, infot, nout, lerr, ok )
2180  infot = 10
2181  CALL zgemm( 'N', 'C', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2182  CALL chkxer( srnamt, infot, nout, lerr, ok )
2183  infot = 10
2184  CALL zgemm( 'C', 'C', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2185  CALL chkxer( srnamt, infot, nout, lerr, ok )
2186  infot = 10
2187  CALL zgemm( 'T', 'C', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2188  CALL chkxer( srnamt, infot, nout, lerr, ok )
2189  infot = 10
2190  CALL zgemm( 'N', 'T', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2191  CALL chkxer( srnamt, infot, nout, lerr, ok )
2192  infot = 10
2193  CALL zgemm( 'C', 'T', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2194  CALL chkxer( srnamt, infot, nout, lerr, ok )
2195  infot = 10
2196  CALL zgemm( 'T', 'T', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2197  CALL chkxer( srnamt, infot, nout, lerr, ok )
2198  infot = 13
2199  CALL zgemm( 'N', 'N', 2, 0, 0, alpha, a, 2, b, 1, beta, c, 1 )
2200  CALL chkxer( srnamt, infot, nout, lerr, ok )
2201  infot = 13
2202  CALL zgemm( 'N', 'C', 2, 0, 0, alpha, a, 2, b, 1, beta, c, 1 )
2203  CALL chkxer( srnamt, infot, nout, lerr, ok )
2204  infot = 13
2205  CALL zgemm( 'N', 'T', 2, 0, 0, alpha, a, 2, b, 1, beta, c, 1 )
2206  CALL chkxer( srnamt, infot, nout, lerr, ok )
2207  infot = 13
2208  CALL zgemm( 'C', 'N', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2209  CALL chkxer( srnamt, infot, nout, lerr, ok )
2210  infot = 13
2211  CALL zgemm( 'C', 'C', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2212  CALL chkxer( srnamt, infot, nout, lerr, ok )
2213  infot = 13
2214  CALL zgemm( 'C', 'T', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2215  CALL chkxer( srnamt, infot, nout, lerr, ok )
2216  infot = 13
2217  CALL zgemm( 'T', 'N', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2218  CALL chkxer( srnamt, infot, nout, lerr, ok )
2219  infot = 13
2220  CALL zgemm( 'T', 'C', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2221  CALL chkxer( srnamt, infot, nout, lerr, ok )
2222  infot = 13
2223  CALL zgemm( 'T', 'T', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2224  CALL chkxer( srnamt, infot, nout, lerr, ok )
2225  GO TO 100
2226  20 infot = 1
2227  CALL zhemm( '/', 'U', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2228  CALL chkxer( srnamt, infot, nout, lerr, ok )
2229  infot = 2
2230  CALL zhemm( 'L', '/', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2231  CALL chkxer( srnamt, infot, nout, lerr, ok )
2232  infot = 3
2233  CALL zhemm( 'L', 'U', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2234  CALL chkxer( srnamt, infot, nout, lerr, ok )
2235  infot = 3
2236  CALL zhemm( 'R', 'U', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2237  CALL chkxer( srnamt, infot, nout, lerr, ok )
2238  infot = 3
2239  CALL zhemm( 'L', 'L', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2240  CALL chkxer( srnamt, infot, nout, lerr, ok )
2241  infot = 3
2242  CALL zhemm( 'R', 'L', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2243  CALL chkxer( srnamt, infot, nout, lerr, ok )
2244  infot = 4
2245  CALL zhemm( 'L', 'U', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2246  CALL chkxer( srnamt, infot, nout, lerr, ok )
2247  infot = 4
2248  CALL zhemm( 'R', 'U', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2249  CALL chkxer( srnamt, infot, nout, lerr, ok )
2250  infot = 4
2251  CALL zhemm( 'L', 'L', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2252  CALL chkxer( srnamt, infot, nout, lerr, ok )
2253  infot = 4
2254  CALL zhemm( 'R', 'L', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2255  CALL chkxer( srnamt, infot, nout, lerr, ok )
2256  infot = 7
2257  CALL zhemm( 'L', 'U', 2, 0, alpha, a, 1, b, 2, beta, c, 2 )
2258  CALL chkxer( srnamt, infot, nout, lerr, ok )
2259  infot = 7
2260  CALL zhemm( 'R', 'U', 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2261  CALL chkxer( srnamt, infot, nout, lerr, ok )
2262  infot = 7
2263  CALL zhemm( 'L', 'L', 2, 0, alpha, a, 1, b, 2, beta, c, 2 )
2264  CALL chkxer( srnamt, infot, nout, lerr, ok )
2265  infot = 7
2266  CALL zhemm( 'R', 'L', 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2267  CALL chkxer( srnamt, infot, nout, lerr, ok )
2268  infot = 9
2269  CALL zhemm( 'L', 'U', 2, 0, alpha, a, 2, b, 1, beta, c, 2 )
2270  CALL chkxer( srnamt, infot, nout, lerr, ok )
2271  infot = 9
2272  CALL zhemm( 'R', 'U', 2, 0, alpha, a, 1, b, 1, beta, c, 2 )
2273  CALL chkxer( srnamt, infot, nout, lerr, ok )
2274  infot = 9
2275  CALL zhemm( 'L', 'L', 2, 0, alpha, a, 2, b, 1, beta, c, 2 )
2276  CALL chkxer( srnamt, infot, nout, lerr, ok )
2277  infot = 9
2278  CALL zhemm( 'R', 'L', 2, 0, alpha, a, 1, b, 1, beta, c, 2 )
2279  CALL chkxer( srnamt, infot, nout, lerr, ok )
2280  infot = 12
2281  CALL zhemm( 'L', 'U', 2, 0, alpha, a, 2, b, 2, beta, c, 1 )
2282  CALL chkxer( srnamt, infot, nout, lerr, ok )
2283  infot = 12
2284  CALL zhemm( 'R', 'U', 2, 0, alpha, a, 1, b, 2, beta, c, 1 )
2285  CALL chkxer( srnamt, infot, nout, lerr, ok )
2286  infot = 12
2287  CALL zhemm( 'L', 'L', 2, 0, alpha, a, 2, b, 2, beta, c, 1 )
2288  CALL chkxer( srnamt, infot, nout, lerr, ok )
2289  infot = 12
2290  CALL zhemm( 'R', 'L', 2, 0, alpha, a, 1, b, 2, beta, c, 1 )
2291  CALL chkxer( srnamt, infot, nout, lerr, ok )
2292  GO TO 100
2293  30 infot = 1
2294  CALL zsymm( '/', 'U', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2295  CALL chkxer( srnamt, infot, nout, lerr, ok )
2296  infot = 2
2297  CALL zsymm( 'L', '/', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2298  CALL chkxer( srnamt, infot, nout, lerr, ok )
2299  infot = 3
2300  CALL zsymm( 'L', 'U', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2301  CALL chkxer( srnamt, infot, nout, lerr, ok )
2302  infot = 3
2303  CALL zsymm( 'R', 'U', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2304  CALL chkxer( srnamt, infot, nout, lerr, ok )
2305  infot = 3
2306  CALL zsymm( 'L', 'L', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2307  CALL chkxer( srnamt, infot, nout, lerr, ok )
2308  infot = 3
2309  CALL zsymm( 'R', 'L', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2310  CALL chkxer( srnamt, infot, nout, lerr, ok )
2311  infot = 4
2312  CALL zsymm( 'L', 'U', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2313  CALL chkxer( srnamt, infot, nout, lerr, ok )
2314  infot = 4
2315  CALL zsymm( 'R', 'U', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2316  CALL chkxer( srnamt, infot, nout, lerr, ok )
2317  infot = 4
2318  CALL zsymm( 'L', 'L', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2319  CALL chkxer( srnamt, infot, nout, lerr, ok )
2320  infot = 4
2321  CALL zsymm( 'R', 'L', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2322  CALL chkxer( srnamt, infot, nout, lerr, ok )
2323  infot = 7
2324  CALL zsymm( 'L', 'U', 2, 0, alpha, a, 1, b, 2, beta, c, 2 )
2325  CALL chkxer( srnamt, infot, nout, lerr, ok )
2326  infot = 7
2327  CALL zsymm( 'R', 'U', 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2328  CALL chkxer( srnamt, infot, nout, lerr, ok )
2329  infot = 7
2330  CALL zsymm( 'L', 'L', 2, 0, alpha, a, 1, b, 2, beta, c, 2 )
2331  CALL chkxer( srnamt, infot, nout, lerr, ok )
2332  infot = 7
2333  CALL zsymm( 'R', 'L', 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2334  CALL chkxer( srnamt, infot, nout, lerr, ok )
2335  infot = 9
2336  CALL zsymm( 'L', 'U', 2, 0, alpha, a, 2, b, 1, beta, c, 2 )
2337  CALL chkxer( srnamt, infot, nout, lerr, ok )
2338  infot = 9
2339  CALL zsymm( 'R', 'U', 2, 0, alpha, a, 1, b, 1, beta, c, 2 )
2340  CALL chkxer( srnamt, infot, nout, lerr, ok )
2341  infot = 9
2342  CALL zsymm( 'L', 'L', 2, 0, alpha, a, 2, b, 1, beta, c, 2 )
2343  CALL chkxer( srnamt, infot, nout, lerr, ok )
2344  infot = 9
2345  CALL zsymm( 'R', 'L', 2, 0, alpha, a, 1, b, 1, beta, c, 2 )
2346  CALL chkxer( srnamt, infot, nout, lerr, ok )
2347  infot = 12
2348  CALL zsymm( 'L', 'U', 2, 0, alpha, a, 2, b, 2, beta, c, 1 )
2349  CALL chkxer( srnamt, infot, nout, lerr, ok )
2350  infot = 12
2351  CALL zsymm( 'R', 'U', 2, 0, alpha, a, 1, b, 2, beta, c, 1 )
2352  CALL chkxer( srnamt, infot, nout, lerr, ok )
2353  infot = 12
2354  CALL zsymm( 'L', 'L', 2, 0, alpha, a, 2, b, 2, beta, c, 1 )
2355  CALL chkxer( srnamt, infot, nout, lerr, ok )
2356  infot = 12
2357  CALL zsymm( 'R', 'L', 2, 0, alpha, a, 1, b, 2, beta, c, 1 )
2358  CALL chkxer( srnamt, infot, nout, lerr, ok )
2359  GO TO 100
2360  40 infot = 1
2361  CALL ztrmm( '/', 'U', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
2362  CALL chkxer( srnamt, infot, nout, lerr, ok )
2363  infot = 2
2364  CALL ztrmm( 'L', '/', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
2365  CALL chkxer( srnamt, infot, nout, lerr, ok )
2366  infot = 3
2367  CALL ztrmm( 'L', 'U', '/', 'N', 0, 0, alpha, a, 1, b, 1 )
2368  CALL chkxer( srnamt, infot, nout, lerr, ok )
2369  infot = 4
2370  CALL ztrmm( 'L', 'U', 'N', '/', 0, 0, alpha, a, 1, b, 1 )
2371  CALL chkxer( srnamt, infot, nout, lerr, ok )
2372  infot = 5
2373  CALL ztrmm( 'L', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2374  CALL chkxer( srnamt, infot, nout, lerr, ok )
2375  infot = 5
2376  CALL ztrmm( 'L', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2377  CALL chkxer( srnamt, infot, nout, lerr, ok )
2378  infot = 5
2379  CALL ztrmm( 'L', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2380  CALL chkxer( srnamt, infot, nout, lerr, ok )
2381  infot = 5
2382  CALL ztrmm( 'R', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2383  CALL chkxer( srnamt, infot, nout, lerr, ok )
2384  infot = 5
2385  CALL ztrmm( 'R', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2386  CALL chkxer( srnamt, infot, nout, lerr, ok )
2387  infot = 5
2388  CALL ztrmm( 'R', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2389  CALL chkxer( srnamt, infot, nout, lerr, ok )
2390  infot = 5
2391  CALL ztrmm( 'L', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2392  CALL chkxer( srnamt, infot, nout, lerr, ok )
2393  infot = 5
2394  CALL ztrmm( 'L', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2395  CALL chkxer( srnamt, infot, nout, lerr, ok )
2396  infot = 5
2397  CALL ztrmm( 'L', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2398  CALL chkxer( srnamt, infot, nout, lerr, ok )
2399  infot = 5
2400  CALL ztrmm( 'R', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2401  CALL chkxer( srnamt, infot, nout, lerr, ok )
2402  infot = 5
2403  CALL ztrmm( 'R', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2404  CALL chkxer( srnamt, infot, nout, lerr, ok )
2405  infot = 5
2406  CALL ztrmm( 'R', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2407  CALL chkxer( srnamt, infot, nout, lerr, ok )
2408  infot = 6
2409  CALL ztrmm( 'L', 'U', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2410  CALL chkxer( srnamt, infot, nout, lerr, ok )
2411  infot = 6
2412  CALL ztrmm( 'L', 'U', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2413  CALL chkxer( srnamt, infot, nout, lerr, ok )
2414  infot = 6
2415  CALL ztrmm( 'L', 'U', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2416  CALL chkxer( srnamt, infot, nout, lerr, ok )
2417  infot = 6
2418  CALL ztrmm( 'R', 'U', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2419  CALL chkxer( srnamt, infot, nout, lerr, ok )
2420  infot = 6
2421  CALL ztrmm( 'R', 'U', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2422  CALL chkxer( srnamt, infot, nout, lerr, ok )
2423  infot = 6
2424  CALL ztrmm( 'R', 'U', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2425  CALL chkxer( srnamt, infot, nout, lerr, ok )
2426  infot = 6
2427  CALL ztrmm( 'L', 'L', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2428  CALL chkxer( srnamt, infot, nout, lerr, ok )
2429  infot = 6
2430  CALL ztrmm( 'L', 'L', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2431  CALL chkxer( srnamt, infot, nout, lerr, ok )
2432  infot = 6
2433  CALL ztrmm( 'L', 'L', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2434  CALL chkxer( srnamt, infot, nout, lerr, ok )
2435  infot = 6
2436  CALL ztrmm( 'R', 'L', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2437  CALL chkxer( srnamt, infot, nout, lerr, ok )
2438  infot = 6
2439  CALL ztrmm( 'R', 'L', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2440  CALL chkxer( srnamt, infot, nout, lerr, ok )
2441  infot = 6
2442  CALL ztrmm( 'R', 'L', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2443  CALL chkxer( srnamt, infot, nout, lerr, ok )
2444  infot = 9
2445  CALL ztrmm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
2446  CALL chkxer( srnamt, infot, nout, lerr, ok )
2447  infot = 9
2448  CALL ztrmm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
2449  CALL chkxer( srnamt, infot, nout, lerr, ok )
2450  infot = 9
2451  CALL ztrmm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
2452  CALL chkxer( srnamt, infot, nout, lerr, ok )
2453  infot = 9
2454  CALL ztrmm( 'R', 'U', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
2455  CALL chkxer( srnamt, infot, nout, lerr, ok )
2456  infot = 9
2457  CALL ztrmm( 'R', 'U', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
2458  CALL chkxer( srnamt, infot, nout, lerr, ok )
2459  infot = 9
2460  CALL ztrmm( 'R', 'U', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
2461  CALL chkxer( srnamt, infot, nout, lerr, ok )
2462  infot = 9
2463  CALL ztrmm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
2464  CALL chkxer( srnamt, infot, nout, lerr, ok )
2465  infot = 9
2466  CALL ztrmm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
2467  CALL chkxer( srnamt, infot, nout, lerr, ok )
2468  infot = 9
2469  CALL ztrmm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
2470  CALL chkxer( srnamt, infot, nout, lerr, ok )
2471  infot = 9
2472  CALL ztrmm( 'R', 'L', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
2473  CALL chkxer( srnamt, infot, nout, lerr, ok )
2474  infot = 9
2475  CALL ztrmm( 'R', 'L', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
2476  CALL chkxer( srnamt, infot, nout, lerr, ok )
2477  infot = 9
2478  CALL ztrmm( 'R', 'L', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
2479  CALL chkxer( srnamt, infot, nout, lerr, ok )
2480  infot = 11
2481  CALL ztrmm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
2482  CALL chkxer( srnamt, infot, nout, lerr, ok )
2483  infot = 11
2484  CALL ztrmm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
2485  CALL chkxer( srnamt, infot, nout, lerr, ok )
2486  infot = 11
2487  CALL ztrmm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
2488  CALL chkxer( srnamt, infot, nout, lerr, ok )
2489  infot = 11
2490  CALL ztrmm( 'R', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
2491  CALL chkxer( srnamt, infot, nout, lerr, ok )
2492  infot = 11
2493  CALL ztrmm( 'R', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
2494  CALL chkxer( srnamt, infot, nout, lerr, ok )
2495  infot = 11
2496  CALL ztrmm( 'R', 'U', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
2497  CALL chkxer( srnamt, infot, nout, lerr, ok )
2498  infot = 11
2499  CALL ztrmm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
2500  CALL chkxer( srnamt, infot, nout, lerr, ok )
2501  infot = 11
2502  CALL ztrmm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
2503  CALL chkxer( srnamt, infot, nout, lerr, ok )
2504  infot = 11
2505  CALL ztrmm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
2506  CALL chkxer( srnamt, infot, nout, lerr, ok )
2507  infot = 11
2508  CALL ztrmm( 'R', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
2509  CALL chkxer( srnamt, infot, nout, lerr, ok )
2510  infot = 11
2511  CALL ztrmm( 'R', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
2512  CALL chkxer( srnamt, infot, nout, lerr, ok )
2513  infot = 11
2514  CALL ztrmm( 'R', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
2515  CALL chkxer( srnamt, infot, nout, lerr, ok )
2516  GO TO 100
2517  50 infot = 1
2518  CALL ztrsm( '/', 'U', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
2519  CALL chkxer( srnamt, infot, nout, lerr, ok )
2520  infot = 2
2521  CALL ztrsm( 'L', '/', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
2522  CALL chkxer( srnamt, infot, nout, lerr, ok )
2523  infot = 3
2524  CALL ztrsm( 'L', 'U', '/', 'N', 0, 0, alpha, a, 1, b, 1 )
2525  CALL chkxer( srnamt, infot, nout, lerr, ok )
2526  infot = 4
2527  CALL ztrsm( 'L', 'U', 'N', '/', 0, 0, alpha, a, 1, b, 1 )
2528  CALL chkxer( srnamt, infot, nout, lerr, ok )
2529  infot = 5
2530  CALL ztrsm( 'L', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2531  CALL chkxer( srnamt, infot, nout, lerr, ok )
2532  infot = 5
2533  CALL ztrsm( 'L', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2534  CALL chkxer( srnamt, infot, nout, lerr, ok )
2535  infot = 5
2536  CALL ztrsm( 'L', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2537  CALL chkxer( srnamt, infot, nout, lerr, ok )
2538  infot = 5
2539  CALL ztrsm( 'R', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2540  CALL chkxer( srnamt, infot, nout, lerr, ok )
2541  infot = 5
2542  CALL ztrsm( 'R', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2543  CALL chkxer( srnamt, infot, nout, lerr, ok )
2544  infot = 5
2545  CALL ztrsm( 'R', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2546  CALL chkxer( srnamt, infot, nout, lerr, ok )
2547  infot = 5
2548  CALL ztrsm( 'L', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2549  CALL chkxer( srnamt, infot, nout, lerr, ok )
2550  infot = 5
2551  CALL ztrsm( 'L', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2552  CALL chkxer( srnamt, infot, nout, lerr, ok )
2553  infot = 5
2554  CALL ztrsm( 'L', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2555  CALL chkxer( srnamt, infot, nout, lerr, ok )
2556  infot = 5
2557  CALL ztrsm( 'R', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
2558  CALL chkxer( srnamt, infot, nout, lerr, ok )
2559  infot = 5
2560  CALL ztrsm( 'R', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
2561  CALL chkxer( srnamt, infot, nout, lerr, ok )
2562  infot = 5
2563  CALL ztrsm( 'R', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
2564  CALL chkxer( srnamt, infot, nout, lerr, ok )
2565  infot = 6
2566  CALL ztrsm( 'L', 'U', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2567  CALL chkxer( srnamt, infot, nout, lerr, ok )
2568  infot = 6
2569  CALL ztrsm( 'L', 'U', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2570  CALL chkxer( srnamt, infot, nout, lerr, ok )
2571  infot = 6
2572  CALL ztrsm( 'L', 'U', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2573  CALL chkxer( srnamt, infot, nout, lerr, ok )
2574  infot = 6
2575  CALL ztrsm( 'R', 'U', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2576  CALL chkxer( srnamt, infot, nout, lerr, ok )
2577  infot = 6
2578  CALL ztrsm( 'R', 'U', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2579  CALL chkxer( srnamt, infot, nout, lerr, ok )
2580  infot = 6
2581  CALL ztrsm( 'R', 'U', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2582  CALL chkxer( srnamt, infot, nout, lerr, ok )
2583  infot = 6
2584  CALL ztrsm( 'L', 'L', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2585  CALL chkxer( srnamt, infot, nout, lerr, ok )
2586  infot = 6
2587  CALL ztrsm( 'L', 'L', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2588  CALL chkxer( srnamt, infot, nout, lerr, ok )
2589  infot = 6
2590  CALL ztrsm( 'L', 'L', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2591  CALL chkxer( srnamt, infot, nout, lerr, ok )
2592  infot = 6
2593  CALL ztrsm( 'R', 'L', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
2594  CALL chkxer( srnamt, infot, nout, lerr, ok )
2595  infot = 6
2596  CALL ztrsm( 'R', 'L', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
2597  CALL chkxer( srnamt, infot, nout, lerr, ok )
2598  infot = 6
2599  CALL ztrsm( 'R', 'L', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
2600  CALL chkxer( srnamt, infot, nout, lerr, ok )
2601  infot = 9
2602  CALL ztrsm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
2603  CALL chkxer( srnamt, infot, nout, lerr, ok )
2604  infot = 9
2605  CALL ztrsm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
2606  CALL chkxer( srnamt, infot, nout, lerr, ok )
2607  infot = 9
2608  CALL ztrsm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
2609  CALL chkxer( srnamt, infot, nout, lerr, ok )
2610  infot = 9
2611  CALL ztrsm( 'R', 'U', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
2612  CALL chkxer( srnamt, infot, nout, lerr, ok )
2613  infot = 9
2614  CALL ztrsm( 'R', 'U', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
2615  CALL chkxer( srnamt, infot, nout, lerr, ok )
2616  infot = 9
2617  CALL ztrsm( 'R', 'U', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
2618  CALL chkxer( srnamt, infot, nout, lerr, ok )
2619  infot = 9
2620  CALL ztrsm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
2621  CALL chkxer( srnamt, infot, nout, lerr, ok )
2622  infot = 9
2623  CALL ztrsm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
2624  CALL chkxer( srnamt, infot, nout, lerr, ok )
2625  infot = 9
2626  CALL ztrsm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
2627  CALL chkxer( srnamt, infot, nout, lerr, ok )
2628  infot = 9
2629  CALL ztrsm( 'R', 'L', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
2630  CALL chkxer( srnamt, infot, nout, lerr, ok )
2631  infot = 9
2632  CALL ztrsm( 'R', 'L', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
2633  CALL chkxer( srnamt, infot, nout, lerr, ok )
2634  infot = 9
2635  CALL ztrsm( 'R', 'L', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
2636  CALL chkxer( srnamt, infot, nout, lerr, ok )
2637  infot = 11
2638  CALL ztrsm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
2639  CALL chkxer( srnamt, infot, nout, lerr, ok )
2640  infot = 11
2641  CALL ztrsm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
2642  CALL chkxer( srnamt, infot, nout, lerr, ok )
2643  infot = 11
2644  CALL ztrsm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
2645  CALL chkxer( srnamt, infot, nout, lerr, ok )
2646  infot = 11
2647  CALL ztrsm( 'R', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
2648  CALL chkxer( srnamt, infot, nout, lerr, ok )
2649  infot = 11
2650  CALL ztrsm( 'R', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
2651  CALL chkxer( srnamt, infot, nout, lerr, ok )
2652  infot = 11
2653  CALL ztrsm( 'R', 'U', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
2654  CALL chkxer( srnamt, infot, nout, lerr, ok )
2655  infot = 11
2656  CALL ztrsm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
2657  CALL chkxer( srnamt, infot, nout, lerr, ok )
2658  infot = 11
2659  CALL ztrsm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
2660  CALL chkxer( srnamt, infot, nout, lerr, ok )
2661  infot = 11
2662  CALL ztrsm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
2663  CALL chkxer( srnamt, infot, nout, lerr, ok )
2664  infot = 11
2665  CALL ztrsm( 'R', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
2666  CALL chkxer( srnamt, infot, nout, lerr, ok )
2667  infot = 11
2668  CALL ztrsm( 'R', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
2669  CALL chkxer( srnamt, infot, nout, lerr, ok )
2670  infot = 11
2671  CALL ztrsm( 'R', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
2672  CALL chkxer( srnamt, infot, nout, lerr, ok )
2673  GO TO 100
2674  60 infot = 1
2675  CALL zherk( '/', 'N', 0, 0, ralpha, a, 1, rbeta, c, 1 )
2676  CALL chkxer( srnamt, infot, nout, lerr, ok )
2677  infot = 2
2678  CALL zherk( 'U', 'T', 0, 0, ralpha, a, 1, rbeta, c, 1 )
2679  CALL chkxer( srnamt, infot, nout, lerr, ok )
2680  infot = 3
2681  CALL zherk( 'U', 'N', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2682  CALL chkxer( srnamt, infot, nout, lerr, ok )
2683  infot = 3
2684  CALL zherk( 'U', 'C', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2685  CALL chkxer( srnamt, infot, nout, lerr, ok )
2686  infot = 3
2687  CALL zherk( 'L', 'N', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2688  CALL chkxer( srnamt, infot, nout, lerr, ok )
2689  infot = 3
2690  CALL zherk( 'L', 'C', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2691  CALL chkxer( srnamt, infot, nout, lerr, ok )
2692  infot = 4
2693  CALL zherk( 'U', 'N', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2694  CALL chkxer( srnamt, infot, nout, lerr, ok )
2695  infot = 4
2696  CALL zherk( 'U', 'C', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2697  CALL chkxer( srnamt, infot, nout, lerr, ok )
2698  infot = 4
2699  CALL zherk( 'L', 'N', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2700  CALL chkxer( srnamt, infot, nout, lerr, ok )
2701  infot = 4
2702  CALL zherk( 'L', 'C', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2703  CALL chkxer( srnamt, infot, nout, lerr, ok )
2704  infot = 7
2705  CALL zherk( 'U', 'N', 2, 0, ralpha, a, 1, rbeta, c, 2 )
2706  CALL chkxer( srnamt, infot, nout, lerr, ok )
2707  infot = 7
2708  CALL zherk( 'U', 'C', 0, 2, ralpha, a, 1, rbeta, c, 1 )
2709  CALL chkxer( srnamt, infot, nout, lerr, ok )
2710  infot = 7
2711  CALL zherk( 'L', 'N', 2, 0, ralpha, a, 1, rbeta, c, 2 )
2712  CALL chkxer( srnamt, infot, nout, lerr, ok )
2713  infot = 7
2714  CALL zherk( 'L', 'C', 0, 2, ralpha, a, 1, rbeta, c, 1 )
2715  CALL chkxer( srnamt, infot, nout, lerr, ok )
2716  infot = 10
2717  CALL zherk( 'U', 'N', 2, 0, ralpha, a, 2, rbeta, c, 1 )
2718  CALL chkxer( srnamt, infot, nout, lerr, ok )
2719  infot = 10
2720  CALL zherk( 'U', 'C', 2, 0, ralpha, a, 1, rbeta, c, 1 )
2721  CALL chkxer( srnamt, infot, nout, lerr, ok )
2722  infot = 10
2723  CALL zherk( 'L', 'N', 2, 0, ralpha, a, 2, rbeta, c, 1 )
2724  CALL chkxer( srnamt, infot, nout, lerr, ok )
2725  infot = 10
2726  CALL zherk( 'L', 'C', 2, 0, ralpha, a, 1, rbeta, c, 1 )
2727  CALL chkxer( srnamt, infot, nout, lerr, ok )
2728  GO TO 100
2729  70 infot = 1
2730  CALL zsyrk( '/', 'N', 0, 0, alpha, a, 1, beta, c, 1 )
2731  CALL chkxer( srnamt, infot, nout, lerr, ok )
2732  infot = 2
2733  CALL zsyrk( 'U', 'C', 0, 0, alpha, a, 1, beta, c, 1 )
2734  CALL chkxer( srnamt, infot, nout, lerr, ok )
2735  infot = 3
2736  CALL zsyrk( 'U', 'N', -1, 0, alpha, a, 1, beta, c, 1 )
2737  CALL chkxer( srnamt, infot, nout, lerr, ok )
2738  infot = 3
2739  CALL zsyrk( 'U', 'T', -1, 0, alpha, a, 1, beta, c, 1 )
2740  CALL chkxer( srnamt, infot, nout, lerr, ok )
2741  infot = 3
2742  CALL zsyrk( 'L', 'N', -1, 0, alpha, a, 1, beta, c, 1 )
2743  CALL chkxer( srnamt, infot, nout, lerr, ok )
2744  infot = 3
2745  CALL zsyrk( 'L', 'T', -1, 0, alpha, a, 1, beta, c, 1 )
2746  CALL chkxer( srnamt, infot, nout, lerr, ok )
2747  infot = 4
2748  CALL zsyrk( 'U', 'N', 0, -1, alpha, a, 1, beta, c, 1 )
2749  CALL chkxer( srnamt, infot, nout, lerr, ok )
2750  infot = 4
2751  CALL zsyrk( 'U', 'T', 0, -1, alpha, a, 1, beta, c, 1 )
2752  CALL chkxer( srnamt, infot, nout, lerr, ok )
2753  infot = 4
2754  CALL zsyrk( 'L', 'N', 0, -1, alpha, a, 1, beta, c, 1 )
2755  CALL chkxer( srnamt, infot, nout, lerr, ok )
2756  infot = 4
2757  CALL zsyrk( 'L', 'T', 0, -1, alpha, a, 1, beta, c, 1 )
2758  CALL chkxer( srnamt, infot, nout, lerr, ok )
2759  infot = 7
2760  CALL zsyrk( 'U', 'N', 2, 0, alpha, a, 1, beta, c, 2 )
2761  CALL chkxer( srnamt, infot, nout, lerr, ok )
2762  infot = 7
2763  CALL zsyrk( 'U', 'T', 0, 2, alpha, a, 1, beta, c, 1 )
2764  CALL chkxer( srnamt, infot, nout, lerr, ok )
2765  infot = 7
2766  CALL zsyrk( 'L', 'N', 2, 0, alpha, a, 1, beta, c, 2 )
2767  CALL chkxer( srnamt, infot, nout, lerr, ok )
2768  infot = 7
2769  CALL zsyrk( 'L', 'T', 0, 2, alpha, a, 1, beta, c, 1 )
2770  CALL chkxer( srnamt, infot, nout, lerr, ok )
2771  infot = 10
2772  CALL zsyrk( 'U', 'N', 2, 0, alpha, a, 2, beta, c, 1 )
2773  CALL chkxer( srnamt, infot, nout, lerr, ok )
2774  infot = 10
2775  CALL zsyrk( 'U', 'T', 2, 0, alpha, a, 1, beta, c, 1 )
2776  CALL chkxer( srnamt, infot, nout, lerr, ok )
2777  infot = 10
2778  CALL zsyrk( 'L', 'N', 2, 0, alpha, a, 2, beta, c, 1 )
2779  CALL chkxer( srnamt, infot, nout, lerr, ok )
2780  infot = 10
2781  CALL zsyrk( 'L', 'T', 2, 0, alpha, a, 1, beta, c, 1 )
2782  CALL chkxer( srnamt, infot, nout, lerr, ok )
2783  GO TO 100
2784  80 infot = 1
2785  CALL zher2k( '/', 'N', 0, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2786  CALL chkxer( srnamt, infot, nout, lerr, ok )
2787  infot = 2
2788  CALL zher2k( 'U', 'T', 0, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2789  CALL chkxer( srnamt, infot, nout, lerr, ok )
2790  infot = 3
2791  CALL zher2k( 'U', 'N', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2792  CALL chkxer( srnamt, infot, nout, lerr, ok )
2793  infot = 3
2794  CALL zher2k( 'U', 'C', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2795  CALL chkxer( srnamt, infot, nout, lerr, ok )
2796  infot = 3
2797  CALL zher2k( 'L', 'N', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2798  CALL chkxer( srnamt, infot, nout, lerr, ok )
2799  infot = 3
2800  CALL zher2k( 'L', 'C', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2801  CALL chkxer( srnamt, infot, nout, lerr, ok )
2802  infot = 4
2803  CALL zher2k( 'U', 'N', 0, -1, alpha, a, 1, b, 1, rbeta, c, 1 )
2804  CALL chkxer( srnamt, infot, nout, lerr, ok )
2805  infot = 4
2806  CALL zher2k( 'U', 'C', 0, -1, alpha, a, 1, b, 1, rbeta, c, 1 )
2807  CALL chkxer( srnamt, infot, nout, lerr, ok )
2808  infot = 4
2809  CALL zher2k( 'L', 'N', 0, -1, alpha, a, 1, b, 1, rbeta, c, 1 )
2810  CALL chkxer( srnamt, infot, nout, lerr, ok )
2811  infot = 4
2812  CALL zher2k( 'L', 'C', 0, -1, alpha, a, 1, b, 1, rbeta, c, 1 )
2813  CALL chkxer( srnamt, infot, nout, lerr, ok )
2814  infot = 7
2815  CALL zher2k( 'U', 'N', 2, 0, alpha, a, 1, b, 1, rbeta, c, 2 )
2816  CALL chkxer( srnamt, infot, nout, lerr, ok )
2817  infot = 7
2818  CALL zher2k( 'U', 'C', 0, 2, alpha, a, 1, b, 1, rbeta, c, 1 )
2819  CALL chkxer( srnamt, infot, nout, lerr, ok )
2820  infot = 7
2821  CALL zher2k( 'L', 'N', 2, 0, alpha, a, 1, b, 1, rbeta, c, 2 )
2822  CALL chkxer( srnamt, infot, nout, lerr, ok )
2823  infot = 7
2824  CALL zher2k( 'L', 'C', 0, 2, alpha, a, 1, b, 1, rbeta, c, 1 )
2825  CALL chkxer( srnamt, infot, nout, lerr, ok )
2826  infot = 9
2827  CALL zher2k( 'U', 'N', 2, 0, alpha, a, 2, b, 1, rbeta, c, 2 )
2828  CALL chkxer( srnamt, infot, nout, lerr, ok )
2829  infot = 9
2830  CALL zher2k( 'U', 'C', 0, 2, alpha, a, 2, b, 1, rbeta, c, 1 )
2831  CALL chkxer( srnamt, infot, nout, lerr, ok )
2832  infot = 9
2833  CALL zher2k( 'L', 'N', 2, 0, alpha, a, 2, b, 1, rbeta, c, 2 )
2834  CALL chkxer( srnamt, infot, nout, lerr, ok )
2835  infot = 9
2836  CALL zher2k( 'L', 'C', 0, 2, alpha, a, 2, b, 1, rbeta, c, 1 )
2837  CALL chkxer( srnamt, infot, nout, lerr, ok )
2838  infot = 12
2839  CALL zher2k( 'U', 'N', 2, 0, alpha, a, 2, b, 2, rbeta, c, 1 )
2840  CALL chkxer( srnamt, infot, nout, lerr, ok )
2841  infot = 12
2842  CALL zher2k( 'U', 'C', 2, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2843  CALL chkxer( srnamt, infot, nout, lerr, ok )
2844  infot = 12
2845  CALL zher2k( 'L', 'N', 2, 0, alpha, a, 2, b, 2, rbeta, c, 1 )
2846  CALL chkxer( srnamt, infot, nout, lerr, ok )
2847  infot = 12
2848  CALL zher2k( 'L', 'C', 2, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
2849  CALL chkxer( srnamt, infot, nout, lerr, ok )
2850  GO TO 100
2851  90 infot = 1
2852  CALL zsyr2k( '/', 'N', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2853  CALL chkxer( srnamt, infot, nout, lerr, ok )
2854  infot = 2
2855  CALL zsyr2k( 'U', 'C', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
2856  CALL chkxer( srnamt, infot, nout, lerr, ok )
2857  infot = 3
2858  CALL zsyr2k( 'U', 'N', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2859  CALL chkxer( srnamt, infot, nout, lerr, ok )
2860  infot = 3
2861  CALL zsyr2k( 'U', 'T', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2862  CALL chkxer( srnamt, infot, nout, lerr, ok )
2863  infot = 3
2864  CALL zsyr2k( 'L', 'N', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2865  CALL chkxer( srnamt, infot, nout, lerr, ok )
2866  infot = 3
2867  CALL zsyr2k( 'L', 'T', -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
2868  CALL chkxer( srnamt, infot, nout, lerr, ok )
2869  infot = 4
2870  CALL zsyr2k( 'U', 'N', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2871  CALL chkxer( srnamt, infot, nout, lerr, ok )
2872  infot = 4
2873  CALL zsyr2k( 'U', 'T', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2874  CALL chkxer( srnamt, infot, nout, lerr, ok )
2875  infot = 4
2876  CALL zsyr2k( 'L', 'N', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2877  CALL chkxer( srnamt, infot, nout, lerr, ok )
2878  infot = 4
2879  CALL zsyr2k( 'L', 'T', 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
2880  CALL chkxer( srnamt, infot, nout, lerr, ok )
2881  infot = 7
2882  CALL zsyr2k( 'U', 'N', 2, 0, alpha, a, 1, b, 1, beta, c, 2 )
2883  CALL chkxer( srnamt, infot, nout, lerr, ok )
2884  infot = 7
2885  CALL zsyr2k( 'U', 'T', 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2886  CALL chkxer( srnamt, infot, nout, lerr, ok )
2887  infot = 7
2888  CALL zsyr2k( 'L', 'N', 2, 0, alpha, a, 1, b, 1, beta, c, 2 )
2889  CALL chkxer( srnamt, infot, nout, lerr, ok )
2890  infot = 7
2891  CALL zsyr2k( 'L', 'T', 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
2892  CALL chkxer( srnamt, infot, nout, lerr, ok )
2893  infot = 9
2894  CALL zsyr2k( 'U', 'N', 2, 0, alpha, a, 2, b, 1, beta, c, 2 )
2895  CALL chkxer( srnamt, infot, nout, lerr, ok )
2896  infot = 9
2897  CALL zsyr2k( 'U', 'T', 0, 2, alpha, a, 2, b, 1, beta, c, 1 )
2898  CALL chkxer( srnamt, infot, nout, lerr, ok )
2899  infot = 9
2900  CALL zsyr2k( 'L', 'N', 2, 0, alpha, a, 2, b, 1, beta, c, 2 )
2901  CALL chkxer( srnamt, infot, nout, lerr, ok )
2902  infot = 9
2903  CALL zsyr2k( 'L', 'T', 0, 2, alpha, a, 2, b, 1, beta, c, 1 )
2904  CALL chkxer( srnamt, infot, nout, lerr, ok )
2905  infot = 12
2906  CALL zsyr2k( 'U', 'N', 2, 0, alpha, a, 2, b, 2, beta, c, 1 )
2907  CALL chkxer( srnamt, infot, nout, lerr, ok )
2908  infot = 12
2909  CALL zsyr2k( 'U', 'T', 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2910  CALL chkxer( srnamt, infot, nout, lerr, ok )
2911  infot = 12
2912  CALL zsyr2k( 'L', 'N', 2, 0, alpha, a, 2, b, 2, beta, c, 1 )
2913  CALL chkxer( srnamt, infot, nout, lerr, ok )
2914  infot = 12
2915  CALL zsyr2k( 'L', 'T', 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
2916  CALL chkxer( srnamt, infot, nout, lerr, ok )
2917 *
2918  100 IF( ok )THEN
2919  WRITE( nout, fmt = 9999 )srnamt
2920  ELSE
2921  WRITE( nout, fmt = 9998 )srnamt
2922  END IF
2923  RETURN
2924 *
2925  9999 FORMAT( ' ', a6, ' PASSED THE TESTS OF ERROR-EXITS' )
2926  9998 FORMAT( ' ******* ', a6, ' FAILED THE TESTS OF ERROR-EXITS *****',
2927  $ '**' )
2928 *
2929 * End of ZCHKE.
2930 *
2931  END
2932  SUBROUTINE zmake( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
2933  $ TRANSL )
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 *
3060  END
3061  SUBROUTINE zmmch( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
3062  $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
3063  $ NOUT, MV )
3064 *
3065 * Checks the results of the computational tests.
3066 *
3067 * Auxiliary routine for test program for Level 3 Blas.
3068 *
3069 * -- Written on 8-February-1989.
3070 * Jack Dongarra, Argonne National Laboratory.
3071 * Iain Duff, AERE Harwell.
3072 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3073 * Sven Hammarling, Numerical Algorithms Group Ltd.
3074 *
3075 * .. Parameters ..
3076  COMPLEX*16 ZERO
3077  PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ) )
3078  DOUBLE PRECISION RZERO, RONE
3079  PARAMETER ( RZERO = 0.0d0, rone = 1.0d0 )
3080 * .. Scalar Arguments ..
3081  COMPLEX*16 ALPHA, BETA
3082  DOUBLE PRECISION EPS, ERR
3083  INTEGER KK, LDA, LDB, LDC, LDCC, M, N, NOUT
3084  LOGICAL FATAL, MV
3085  CHARACTER*1 TRANSA, TRANSB
3086 * .. Array Arguments ..
3087  COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ),
3088  $ CC( LDCC, * ), CT( * )
3089  DOUBLE PRECISION G( * )
3090 * .. Local Scalars ..
3091  COMPLEX*16 CL
3092  DOUBLE PRECISION ERRI
3093  INTEGER I, J, K
3094  LOGICAL CTRANA, CTRANB, TRANA, TRANB
3095 * .. Intrinsic Functions ..
3096  INTRINSIC abs, dimag, dconjg, max, dble, sqrt
3097 * .. Statement Functions ..
3098  DOUBLE PRECISION ABS1
3099 * .. Statement Function definitions ..
3100  abs1( cl ) = abs( dble( cl ) ) + abs( dimag( cl ) )
3101 * .. Executable Statements ..
3102  trana = transa.EQ.'T'.OR.transa.EQ.'C'
3103  tranb = transb.EQ.'T'.OR.transb.EQ.'C'
3104  ctrana = transa.EQ.'C'
3105  ctranb = transb.EQ.'C'
3106 *
3107 * Compute expected result, one column at a time, in CT using data
3108 * in A, B and C.
3109 * Compute gauges in G.
3110 *
3111  DO 220 j = 1, n
3112 *
3113  DO 10 i = 1, m
3114  ct( i ) = zero
3115  g( i ) = rzero
3116  10 CONTINUE
3117  IF( .NOT.trana.AND..NOT.tranb )THEN
3118  DO 30 k = 1, kk
3119  DO 20 i = 1, m
3120  ct( i ) = ct( i ) + a( i, k )*b( k, j )
3121  g( i ) = g( i ) + abs1( a( i, k ) )*abs1( b( k, j ) )
3122  20 CONTINUE
3123  30 CONTINUE
3124  ELSE IF( trana.AND..NOT.tranb )THEN
3125  IF( ctrana )THEN
3126  DO 50 k = 1, kk
3127  DO 40 i = 1, m
3128  ct( i ) = ct( i ) + dconjg( a( k, i ) )*b( k, j )
3129  g( i ) = g( i ) + abs1( a( k, i ) )*
3130  $ abs1( b( k, j ) )
3131  40 CONTINUE
3132  50 CONTINUE
3133  ELSE
3134  DO 70 k = 1, kk
3135  DO 60 i = 1, m
3136  ct( i ) = ct( i ) + a( k, i )*b( k, j )
3137  g( i ) = g( i ) + abs1( a( k, i ) )*
3138  $ abs1( b( k, j ) )
3139  60 CONTINUE
3140  70 CONTINUE
3141  END IF
3142  ELSE IF( .NOT.trana.AND.tranb )THEN
3143  IF( ctranb )THEN
3144  DO 90 k = 1, kk
3145  DO 80 i = 1, m
3146  ct( i ) = ct( i ) + a( i, k )*dconjg( b( j, k ) )
3147  g( i ) = g( i ) + abs1( a( i, k ) )*
3148  $ abs1( b( j, k ) )
3149  80 CONTINUE
3150  90 CONTINUE
3151  ELSE
3152  DO 110 k = 1, kk
3153  DO 100 i = 1, m
3154  ct( i ) = ct( i ) + a( i, k )*b( j, k )
3155  g( i ) = g( i ) + abs1( a( i, k ) )*
3156  $ abs1( b( j, k ) )
3157  100 CONTINUE
3158  110 CONTINUE
3159  END IF
3160  ELSE IF( trana.AND.tranb )THEN
3161  IF( ctrana )THEN
3162  IF( ctranb )THEN
3163  DO 130 k = 1, kk
3164  DO 120 i = 1, m
3165  ct( i ) = ct( i ) + dconjg( a( k, i ) )*
3166  $ dconjg( b( j, k ) )
3167  g( i ) = g( i ) + abs1( a( k, i ) )*
3168  $ abs1( b( j, k ) )
3169  120 CONTINUE
3170  130 CONTINUE
3171  ELSE
3172  DO 150 k = 1, kk
3173  DO 140 i = 1, m
3174  ct( i ) = ct( i ) + dconjg( a( k, i ) )*
3175  $ b( j, k )
3176  g( i ) = g( i ) + abs1( a( k, i ) )*
3177  $ abs1( b( j, k ) )
3178  140 CONTINUE
3179  150 CONTINUE
3180  END IF
3181  ELSE
3182  IF( ctranb )THEN
3183  DO 170 k = 1, kk
3184  DO 160 i = 1, m
3185  ct( i ) = ct( i ) + a( k, i )*
3186  $ dconjg( b( j, k ) )
3187  g( i ) = g( i ) + abs1( a( k, i ) )*
3188  $ abs1( b( j, k ) )
3189  160 CONTINUE
3190  170 CONTINUE
3191  ELSE
3192  DO 190 k = 1, kk
3193  DO 180 i = 1, m
3194  ct( i ) = ct( i ) + a( k, i )*b( j, k )
3195  g( i ) = g( i ) + abs1( a( k, i ) )*
3196  $ abs1( b( j, k ) )
3197  180 CONTINUE
3198  190 CONTINUE
3199  END IF
3200  END IF
3201  END IF
3202  DO 200 i = 1, m
3203  ct( i ) = alpha*ct( i ) + beta*c( i, j )
3204  g( i ) = abs1( alpha )*g( i ) +
3205  $ abs1( beta )*abs1( c( i, j ) )
3206  200 CONTINUE
3207 *
3208 * Compute the error ratio for this result.
3209 *
3210  err = zero
3211  DO 210 i = 1, m
3212  erri = abs1( ct( i ) - cc( i, j ) )/eps
3213  IF( g( i ).NE.rzero )
3214  $ erri = erri/g( i )
3215  err = max( err, erri )
3216  IF( err*sqrt( eps ).GE.rone )
3217  $ GO TO 230
3218  210 CONTINUE
3219 *
3220  220 CONTINUE
3221 *
3222 * If the loop completes, all results are at least half accurate.
3223  GO TO 250
3224 *
3225 * Report fatal error.
3226 *
3227  230 fatal = .true.
3228  WRITE( nout, fmt = 9999 )
3229  DO 240 i = 1, m
3230  IF( mv )THEN
3231  WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
3232  ELSE
3233  WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
3234  END IF
3235  240 CONTINUE
3236  IF( n.GT.1 )
3237  $ WRITE( nout, fmt = 9997 )j
3238 *
3239  250 CONTINUE
3240  RETURN
3241 *
3242  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
3243  $ 'F ACCURATE *******', /' EXPECTED RE',
3244  $ 'SULT COMPUTED RESULT' )
3245  9998 FORMAT( 1x, i7, 2( ' (', g15.6, ',', g15.6, ')' ) )
3246  9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', i3 )
3247 *
3248 * End of ZMMCH.
3249 *
3250  END
3251  LOGICAL FUNCTION lze( RI, RJ, LR )
3252 *
3253 * Tests if two arrays are identical.
3254 *
3255 * Auxiliary routine for test program for Level 3 Blas.
3256 *
3257 * -- Written on 8-February-1989.
3258 * Jack Dongarra, Argonne National Laboratory.
3259 * Iain Duff, AERE Harwell.
3260 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3261 * Sven Hammarling, Numerical Algorithms Group Ltd.
3262 *
3263 * .. Scalar Arguments ..
3264  INTEGER lr
3265 * .. Array Arguments ..
3266  COMPLEX*16 ri( * ), rj( * )
3267 * .. Local Scalars ..
3268  INTEGER i
3269 * .. Executable Statements ..
3270  do 10 i = 1, lr
3271  IF( ri( i ).NE.rj( i ) )
3272  $ GO TO 20
3273  10 CONTINUE
3274  lze = .true.
3275  GO TO 30
3276  20 CONTINUE
3277  lze = .false.
3278  30 RETURN
3279 *
3280 * End of LZE.
3281 *
3282  END
3283  LOGICAL FUNCTION lzeres( TYPE, UPLO, M, N, AA, AS, LDA )
3284 *
3285 * Tests if selected elements in two arrays are equal.
3286 *
3287 * TYPE is 'GE' or 'HE' or 'SY'.
3288 *
3289 * Auxiliary routine for test program for Level 3 Blas.
3290 *
3291 * -- Written on 8-February-1989.
3292 * Jack Dongarra, Argonne National Laboratory.
3293 * Iain Duff, AERE Harwell.
3294 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3295 * Sven Hammarling, Numerical Algorithms Group Ltd.
3296 *
3297 * .. Scalar Arguments ..
3298  INTEGER lda, m, n
3299  CHARACTER*1 uplo
3300  CHARACTER*2 type
3301 * .. Array Arguments ..
3302  COMPLEX*16 aa( lda, * ), as( lda, * )
3303 * .. Local Scalars ..
3304  INTEGER i, ibeg, iend, j
3305  LOGICAL upper
3306 * .. Executable Statements ..
3307  upper = uplo.EQ.'U'
3308  IF( type.EQ.'GE' )THEN
3309  DO 20 j = 1, n
3310  DO 10 i = m + 1, lda
3311  IF( aa( i, j ).NE.as( i, j ) )
3312  $ GO TO 70
3313  10 CONTINUE
3314  20 CONTINUE
3315  ELSE IF( type.EQ.'HE'.OR.type.EQ.'SY' )THEN
3316  DO 50 j = 1, n
3317  IF( upper )THEN
3318  ibeg = 1
3319  iend = j
3320  ELSE
3321  ibeg = j
3322  iend = n
3323  END IF
3324  DO 30 i = 1, ibeg - 1
3325  IF( aa( i, j ).NE.as( i, j ) )
3326  $ GO TO 70
3327  30 CONTINUE
3328  DO 40 i = iend + 1, lda
3329  IF( aa( i, j ).NE.as( i, j ) )
3330  $ GO TO 70
3331  40 CONTINUE
3332  50 CONTINUE
3333  END IF
3334 *
3335  lzeres = .true.
3336  GO TO 80
3337  70 CONTINUE
3338  lzeres = .false.
3339  80 RETURN
3340 *
3341 * End of LZERES.
3342 *
3343  END
3344  COMPLEX*16 FUNCTION zbeg( RESET )
3345 *
3346 * Generates complex numbers as pairs of random numbers uniformly
3347 * distributed between -0.5 and 0.5.
3348 *
3349 * Auxiliary routine for test program for Level 3 Blas.
3350 *
3351 * -- Written on 8-February-1989.
3352 * Jack Dongarra, Argonne National Laboratory.
3353 * Iain Duff, AERE Harwell.
3354 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3355 * Sven Hammarling, Numerical Algorithms Group Ltd.
3356 *
3357 * .. Scalar Arguments ..
3358  LOGICAL reset
3359 * .. Local Scalars ..
3360  INTEGER i, ic, j, mi, mj
3361 * .. Save statement ..
3362  SAVE i, ic, j, mi, mj
3363 * .. Intrinsic Functions ..
3364  INTRINSIC dcmplx
3365 * .. Executable Statements ..
3366  if( reset )then
3367 * Initialize local variables.
3368  mi = 891
3369  mj = 457
3370  i = 7
3371  j = 7
3372  ic = 0
3373  reset = .false.
3374  END IF
3375 *
3376 * The sequence of values of I or J is bounded between 1 and 999.
3377 * If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
3378 * If initial I or J = 4 or 8, the period will be 25.
3379 * If initial I or J = 5, the period will be 10.
3380 * IC is used to break up the period by skipping 1 value of I or J
3381 * in 6.
3382 *
3383  ic = ic + 1
3384  10 i = i*mi
3385  j = j*mj
3386  i = i - 1000*( i/1000 )
3387  j = j - 1000*( j/1000 )
3388  IF( ic.GE.5 )THEN
3389  ic = 0
3390  GO TO 10
3391  END IF
3392  zbeg = dcmplx( ( i - 500 )/1001.0d0, ( j - 500 )/1001.0d0 )
3393  RETURN
3394 *
3395 * End of ZBEG.
3396 *
3397  END
3398  DOUBLE PRECISION FUNCTION ddiff( X, Y )
3399 *
3400 * Auxiliary routine for test program for Level 3 Blas.
3401 *
3402 * -- Written on 8-February-1989.
3403 * Jack Dongarra, Argonne National Laboratory.
3404 * Iain Duff, AERE Harwell.
3405 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3406 * Sven Hammarling, Numerical Algorithms Group Ltd.
3407 *
3408 * .. Scalar Arguments ..
3409  DOUBLE PRECISION x, y
3410 * .. Executable Statements ..
3411  ddiff = x - y
3412  RETURN
3413 *
3414 * End of DDIFF.
3415 *
3416  END
3417  SUBROUTINE chkxer( SRNAMT, INFOT, NOUT, LERR, OK )
3418 *
3419 * Tests whether XERBLA has detected an error when it should.
3420 *
3421 * Auxiliary routine for test program for Level 3 Blas.
3422 *
3423 * -- Written on 8-February-1989.
3424 * Jack Dongarra, Argonne National Laboratory.
3425 * Iain Duff, AERE Harwell.
3426 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3427 * Sven Hammarling, Numerical Algorithms Group Ltd.
3428 *
3429 * .. Scalar Arguments ..
3430  INTEGER INFOT, NOUT
3431  LOGICAL LERR, OK
3432  CHARACTER*6 SRNAMT
3433 * .. Executable Statements ..
3434  IF( .NOT.LERR )THEN
3435  WRITE( NOUT, FMT = 9999 )infot, srnamt
3436  ok = .false.
3437  END IF
3438  lerr = .false.
3439  RETURN
3440 *
3441  9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', i2, ' NOT D',
3442  $ 'ETECTED BY ', a6, ' *****' )
3443 *
3444 * End of CHKXER.
3445 *
3446  END
3447  SUBROUTINE xerbla( SRNAME, INFO )
3448 *
3449 * This is a special version of XERBLA to be used only as part of
3450 * the test program for testing error exits from the Level 3 BLAS
3451 * routines.
3452 *
3453 * XERBLA is an error handler for the Level 3 BLAS routines.
3454 *
3455 * It is called by the Level 3 BLAS routines if an input parameter is
3456 * invalid.
3457 *
3458 * Auxiliary routine for test program for Level 3 Blas.
3459 *
3460 * -- Written on 8-February-1989.
3461 * Jack Dongarra, Argonne National Laboratory.
3462 * Iain Duff, AERE Harwell.
3463 * Jeremy Du Croz, Numerical Algorithms Group Ltd.
3464 * Sven Hammarling, Numerical Algorithms Group Ltd.
3465 *
3466 * .. Scalar Arguments ..
3467  INTEGER INFO
3468  CHARACTER*6 SRNAME
3469 * .. Scalars in Common ..
3470  INTEGER INFOT, NOUT
3471  LOGICAL LERR, OK
3472  CHARACTER*6 SRNAMT
3473 * .. Common blocks ..
3474  COMMON /INFOC/INFOT, NOUT, OK, LERR
3475  COMMON /SRNAMC/SRNAMT
3476 * .. Executable Statements ..
3477  LERR = .true.
3478  IF( info.NE.infot )THEN
3479  IF( infot.NE.0 )THEN
3480  WRITE( nout, fmt = 9999 )info, infot
3481  ELSE
3482  WRITE( nout, fmt = 9997 )info
3483  END IF
3484  ok = .false.
3485  END IF
3486  IF( srname.NE.srnamt )THEN
3487  WRITE( nout, fmt = 9998 )srname, srnamt
3488  ok = .false.
3489  END IF
3490  RETURN
3491 *
3492  9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', i6, ' INSTEAD',
3493  $ ' OF ', i2, ' *******' )
3494  9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', a6, ' INSTE',
3495  $ 'AD OF ', a6, ' *******' )
3496  9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', i6,
3497  $ ' *******' )
3498 *
3499 * End of XERBLA
3500 *
3501  END
3502 
zher2k
subroutine zher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHER2K
Definition: zher2k.f:200
zmake
subroutine zmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
Definition: zblat2.f:2726
ddiff
double precision function ddiff(X, Y)
Definition: dblat2.f:3080
zchke
subroutine zchke(ISNUM, SRNAMT, NOUT)
Definition: zblat2.f:2382
ztrsm
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
Definition: ztrsm.f:182
lzeres
logical function lzeres(TYPE, UPLO, M, N, AA, AS, LDA)
Definition: zblat2.f:3080
zbeg
complex *16 function zbeg(RESET)
Definition: zblat2.f:3139
zchk5
subroutine zchk5(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
Definition: zblat2.f:1777
zsyr2k
subroutine zsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZSYR2K
Definition: zsyr2k.f:190
zhemm
subroutine zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHEMM
Definition: zhemm.f:193
zchk4
subroutine zchk4(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
Definition: zblat2.f:1499
zgemm
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
zblat3
program zblat3
ZBLAT3
Definition: zblat3.f:87
zherk
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
Definition: zherk.f:175
zchk3
subroutine zchk3(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, XT, G, Z)
Definition: zblat2.f:1136
zchk1
subroutine zchk1(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G)
Definition: zblat2.f:442
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
zsyrk
subroutine zsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZSYRK
Definition: zsyrk.f:169
lze
logical function lze(RI, RJ, LR)
Definition: zblat2.f:3050
ztrmm
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
Definition: ztrmm.f:179
zsymm
subroutine zsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZSYMM
Definition: zsymm.f:191
zchk2
subroutine zchk2(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G)
Definition: zblat2.f:788
zmmch
subroutine zmmch(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, NOUT, MV)
Definition: zblat3.f:3064