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