zblat3.f File Reference

Go to the source code of this file.

Functions/Subroutines
program	zblat3
	ZBLAT3
subroutine	zchk1 (sname, eps, thresh, nout, ntra, trace, rewi, fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, c, cc, cs, ct, g)
subroutine	zchk2 (sname, eps, thresh, nout, ntra, trace, rewi, fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, c, cc, cs, ct, g)
subroutine	zchk3 (sname, eps, thresh, nout, ntra, trace, rewi, fatal, nidim, idim, nalf, alf, nmax, a, aa, as, b, bb, bs, ct, g, c)
subroutine	zchk4 (sname, eps, thresh, nout, ntra, trace, rewi, fatal, nidim, idim, nalf, alf, nbet, bet, nmax, a, aa, as, b, bb, bs, c, cc, cs, ct, g)
subroutine	zchk5 (sname, eps, thresh, nout, ntra, trace, rewi, fatal, nidim, idim, nalf, alf, nbet, bet, nmax, ab, aa, as, bb, bs, c, cc, cs, ct, g, w)
subroutine	zchke (isnum, srnamt, nout)
subroutine	zmake (type, uplo, diag, m, n, a, nmax, aa, lda, reset, transl)
subroutine	zmmch (transa, transb, m, n, kk, alpha, a, lda, b, ldb, beta, c, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv)
logical function	lze (ri, rj, lr)
logical function	lzeres (type, uplo, m, n, aa, as, lda)
complex *16 function	zbeg (reset)
double precision function	ddiff (x, y)
subroutine	chkxer (srnamt, infot, nout, lerr, ok)
subroutine	xerbla (srname, info)

Function/Subroutine Documentation

chkxer()

subroutine chkxer	(	character*6	srnamt,
		integer	infot,
		integer	nout,
		logical	lerr,
		logical	ok )

Definition at line 3414 of file zblat3.f.

*
*  Tests whether XERBLA has detected an error when it should.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Scalar Arguments ..
      INTEGER            INFOT, NOUT
      LOGICAL            LERR, OK
      CHARACTER*6        SRNAMT
*     .. Executable Statements ..
      IF( .NOT.lerr )THEN
         WRITE( nout, fmt = 9999 )infot, srnamt
         ok = .false.
      END IF
      lerr = .false.
      RETURN
*
 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', i2, ' NOT D',
     $      'ETECTED BY ', a6, ' *****' )
*
*     End of CHKXER
*

ddiff()

double precision function ddiff	(	double precision	x,
		double precision	y )

Definition at line 3395 of file zblat3.f.

*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Scalar Arguments ..
      DOUBLE PRECISION   X, Y
*     .. Executable Statements ..
      ddiff = x - y
      RETURN
*
*     End of DDIFF
*

lze()

logical function lze	(	complex*16, dimension( * )	ri,
		complex*16, dimension( * )	rj,
		integer	lr )

Definition at line 3248 of file zblat3.f.

*
*  Tests if two arrays are identical.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Scalar Arguments ..
      INTEGER            LR
*     .. Array Arguments ..
      COMPLEX*16         RI( * ), RJ( * )
*     .. Local Scalars ..
      INTEGER            I
*     .. Executable Statements ..
      DO 10 i = 1, lr
         IF( ri( i ).NE.rj( i ) )
     $      GO TO 20
   10 CONTINUE
      lze = .true.
      GO TO 30
   20 CONTINUE
      lze = .false.
   30 RETURN
*
*     End of LZE
*

lzeres()

logical function lzeres	(	character*2	type,
		character*1	uplo,
		integer	m,
		integer	n,
		complex*16, dimension( lda, * )	aa,
		complex*16, dimension( lda, * )	as,
		integer	lda )

Definition at line 3280 of file zblat3.f.

*
*  Tests if selected elements in two arrays are equal.
*
*  TYPE is 'GE' or 'HE' or 'SY'.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Scalar Arguments ..
      INTEGER            LDA, M, N
      CHARACTER*1        UPLO
      CHARACTER*2        TYPE
*     .. Array Arguments ..
      COMPLEX*16         AA( LDA, * ), AS( LDA, * )
*     .. Local Scalars ..
      INTEGER            I, IBEG, IEND, J
      LOGICAL            UPPER
*     .. Executable Statements ..
      upper = uplo.EQ.'U'
      IF( type.EQ.'GE' )THEN
         DO 20 j = 1, n
            DO 10 i = m + 1, lda
               IF( aa( i, j ).NE.as( i, j ) )
     $            GO TO 70
   10       CONTINUE
   20    CONTINUE
      ELSE IF( type.EQ.'HE'.OR.type.EQ.'SY' )THEN
         DO 50 j = 1, n
            IF( upper )THEN
               ibeg = 1
               iend = j
            ELSE
               ibeg = j
               iend = n
            END IF
            DO 30 i = 1, ibeg - 1
               IF( aa( i, j ).NE.as( i, j ) )
     $            GO TO 70
   30       CONTINUE
            DO 40 i = iend + 1, lda
               IF( aa( i, j ).NE.as( i, j ) )
     $            GO TO 70
   40       CONTINUE
   50    CONTINUE
      END IF
*
      lzeres = .true.
      GO TO 80
   70 CONTINUE
      lzeres = .false.
   80 RETURN
*
*     End of LZERES
*

xerbla()

subroutine xerbla	(	character*6	srname,
		integer	info )

Definition at line 3444 of file zblat3.f.

*
*  This is a special version of XERBLA to be used only as part of
*  the test program for testing error exits from the Level 3 BLAS
*  routines.
*
*  XERBLA  is an error handler for the Level 3 BLAS routines.
*
*  It is called by the Level 3 BLAS routines if an input parameter is
*  invalid.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Scalar Arguments ..
      INTEGER            INFO
      CHARACTER*6        SRNAME
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUT
      LOGICAL            LERR, OK
      CHARACTER*6        SRNAMT
*     .. Common blocks ..
      COMMON             /infoc/infot, nout, ok, lerr
      COMMON             /srnamc/srnamt
*     .. Executable Statements ..
      lerr = .true.
      IF( info.NE.infot )THEN
         IF( infot.NE.0 )THEN
            WRITE( nout, fmt = 9999 )info, infot
         ELSE
            WRITE( nout, fmt = 9997 )info
         END IF
         ok = .false.
      END IF
      IF( srname.NE.srnamt )THEN
         WRITE( nout, fmt = 9998 )srname, srnamt
         ok = .false.
      END IF
      RETURN
*
 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', i6, ' instead',
     $      ' of ', I2, ' *******' )
 9998 FORMAT( ' ******* xerbla was called with srname = ', A6, ' inste',
     $      'ad of ', A6, ' *******' )
 9997 FORMAT( ' ******* xerbla was called with info = ', I6,
     $      ' *******' )
*
*     End of XERBLA
*

zbeg()

complex*16 function zbeg

(

logical

reset

)

Definition at line 3341 of file zblat3.f.

*
*  Generates complex numbers as pairs of random numbers uniformly
*  distributed between -0.5 and 0.5.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Scalar Arguments ..
      LOGICAL            RESET
*     .. Local Scalars ..
      INTEGER            I, IC, J, MI, MJ
*     .. Save statement ..
      SAVE               i, ic, j, mi, mj
*     .. Intrinsic Functions ..
      INTRINSIC          dcmplx
*     .. Executable Statements ..
      IF( reset )THEN
*        Initialize local variables.
         mi = 891
         mj = 457
         i = 7
         j = 7
         ic = 0
         reset = .false.
      END IF
*
*     The sequence of values of I or J is bounded between 1 and 999.
*     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
*     If initial I or J = 4 or 8, the period will be 25.
*     If initial I or J = 5, the period will be 10.
*     IC is used to break up the period by skipping 1 value of I or J
*     in 6.
*
      ic = ic + 1
   10 i = i*mi
      j = j*mj
      i = i - 1000*( i/1000 )
      j = j - 1000*( j/1000 )
      IF( ic.GE.5 )THEN
         ic = 0
         GO TO 10
      END IF
      zbeg = dcmplx( ( i - 500 )/1001.0d0, ( j - 500 )/1001.0d0 )
      RETURN
*
*     End of ZBEG
*

zchk1()

subroutine zchk1	(	character*6	sname,
		double precision	eps,
		double precision	thresh,
		integer	nout,
		integer	ntra,
		logical	trace,
		logical	rewi,
		logical	fatal,
		integer	nidim,
		integer, dimension( nidim )	idim,
		integer	nalf,
		complex*16, dimension( nalf )	alf,
		integer	nbet,
		complex*16, dimension( nbet )	bet,
		integer	nmax,
		complex*16, dimension( nmax, nmax )	a,
		complex*16, dimension( nmax*nmax )	aa,
		complex*16, dimension( nmax*nmax )	as,
		complex*16, dimension( nmax, nmax )	b,
		complex*16, dimension( nmax*nmax )	bb,
		complex*16, dimension( nmax*nmax )	bs,
		complex*16, dimension( nmax, nmax )	c,
		complex*16, dimension( nmax*nmax )	cc,
		complex*16, dimension( nmax*nmax )	cs,
		complex*16, dimension( nmax )	ct,
		double precision, dimension( nmax )	g )

Definition at line 404 of file zblat3.f.

*
*  Tests ZGEMM.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO
      parameter( zero = ( 0.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RZERO
      parameter( rzero = 0.0d0 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   EPS, THRESH
      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
      LOGICAL            FATAL, REWI, TRACE
      CHARACTER*6        SNAME
*     .. Array Arguments ..
      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
     $                   CS( NMAX*NMAX ), CT( NMAX )
      DOUBLE PRECISION   G( NMAX )
      INTEGER            IDIM( NIDIM )
*     .. Local Scalars ..
      COMPLEX*16         ALPHA, ALS, BETA, BLS
      DOUBLE PRECISION   ERR, ERRMAX
      INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
     $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
     $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
      LOGICAL            NULL, RESET, SAME, TRANA, TRANB
      CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
      CHARACTER*3        ICH
*     .. Local Arrays ..
      LOGICAL            ISAME( 13 )
*     .. External Functions ..
      LOGICAL            LZE, LZERES
      EXTERNAL           lze, lzeres
*     .. External Subroutines ..
      EXTERNAL           zgemm, zmake, zmmch
*     .. Intrinsic Functions ..
      INTRINSIC          max
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
*     .. Common blocks ..
      COMMON             /infoc/infot, noutc, ok, lerr
*     .. Data statements ..
      DATA               ich/'NTC'/
*     .. Executable Statements ..
*
      nargs = 13
      nc = 0
      reset = .true.
      errmax = rzero
*
      DO 110 im = 1, nidim
         m = idim( im )
*
         DO 100 in = 1, nidim
            n = idim( in )
*           Set LDC to 1 more than minimum value if room.
            ldc = m
            IF( ldc.LT.nmax )
     $         ldc = ldc + 1
*           Skip tests if not enough room.
            IF( ldc.GT.nmax )
     $         GO TO 100
            lcc = ldc*n
            null = n.LE.0.OR.m.LE.0
*
            DO 90 ik = 1, nidim
               k = idim( ik )
*
               DO 80 ica = 1, 3
                  transa = ich( ica: ica )
                  trana = transa.EQ.'T'.OR.transa.EQ.'C'
*
                  IF( trana )THEN
                     ma = k
                     na = m
                  ELSE
                     ma = m
                     na = k
                  END IF
*                 Set LDA to 1 more than minimum value if room.
                  lda = ma
                  IF( lda.LT.nmax )
     $               lda = lda + 1
*                 Skip tests if not enough room.
                  IF( lda.GT.nmax )
     $               GO TO 80
                  laa = lda*na
*
*                 Generate the matrix A.
*
                  CALL zmake( 'GE', ' ', ' ', ma, na, a, nmax, aa, lda,
     $                        reset, zero )
*
                  DO 70 icb = 1, 3
                     transb = ich( icb: icb )
                     tranb = transb.EQ.'T'.OR.transb.EQ.'C'
*
                     IF( tranb )THEN
                        mb = n
                        nb = k
                     ELSE
                        mb = k
                        nb = n
                     END IF
*                    Set LDB to 1 more than minimum value if room.
                     ldb = mb
                     IF( ldb.LT.nmax )
     $                  ldb = ldb + 1
*                    Skip tests if not enough room.
                     IF( ldb.GT.nmax )
     $                  GO TO 70
                     lbb = ldb*nb
*
*                    Generate the matrix B.
*
                     CALL zmake( 'GE', ' ', ' ', mb, nb, b, nmax, bb,
     $                           ldb, reset, zero )
*
                     DO 60 ia = 1, nalf
                        alpha = alf( ia )
*
                        DO 50 ib = 1, nbet
                           beta = bet( ib )
*
*                          Generate the matrix C.
*
                           CALL zmake( 'GE', ' ', ' ', m, n, c, nmax,
     $                                 cc, ldc, reset, zero )
*
                           nc = nc + 1
*
*                          Save every datum before calling the
*                          subroutine.
*
                           tranas = transa
                           tranbs = transb
                           ms = m
                           ns = n
                           ks = k
                           als = alpha
                           DO 10 i = 1, laa
                              as( i ) = aa( i )
   10                      CONTINUE
                           ldas = lda
                           DO 20 i = 1, lbb
                              bs( i ) = bb( i )
   20                      CONTINUE
                           ldbs = ldb
                           bls = beta
                           DO 30 i = 1, lcc
                              cs( i ) = cc( i )
   30                      CONTINUE
                           ldcs = ldc
*
*                          Call the subroutine.
*
                           IF( trace )
     $                        WRITE( ntra, fmt = 9995 )nc, sname,
     $                        transa, transb, m, n, k, alpha, lda, ldb,
     $                        beta, ldc
                           IF( rewi )
     $                        rewind ntra
                           CALL zgemm( transa, transb, m, n, k, alpha,
     $                                 aa, lda, bb, ldb, beta, cc, ldc )
*
*                          Check if error-exit was taken incorrectly.
*
                           IF( .NOT.ok )THEN
                              WRITE( nout, fmt = 9994 )
                              fatal = .true.
                              GO TO 120
                           END IF
*
*                          See what data changed inside subroutines.
*
                           isame( 1 ) = transa.EQ.tranas
                           isame( 2 ) = transb.EQ.tranbs
                           isame( 3 ) = ms.EQ.m
                           isame( 4 ) = ns.EQ.n
                           isame( 5 ) = ks.EQ.k
                           isame( 6 ) = als.EQ.alpha
                           isame( 7 ) = lze( as, aa, laa )
                           isame( 8 ) = ldas.EQ.lda
                           isame( 9 ) = lze( bs, bb, lbb )
                           isame( 10 ) = ldbs.EQ.ldb
                           isame( 11 ) = bls.EQ.beta
                           IF( null )THEN
                              isame( 12 ) = lze( cs, cc, lcc )
                           ELSE
                              isame( 12 ) = lzeres( 'GE', ' ', m, n, cs,
     $                                      cc, ldc )
                           END IF
                           isame( 13 ) = ldcs.EQ.ldc
*
*                          If data was incorrectly changed, report
*                          and return.
*
                           same = .true.
                           DO 40 i = 1, nargs
                              same = same.AND.isame( i )
                              IF( .NOT.isame( i ) )
     $                           WRITE( nout, fmt = 9998 )i
   40                      CONTINUE
                           IF( .NOT.same )THEN
                              fatal = .true.
                              GO TO 120
                           END IF
*
                           IF( .NOT.null )THEN
*
*                             Check the result.
*
                              CALL zmmch( transa, transb, m, n, k,
     $                                    alpha, a, nmax, b, nmax, beta,
     $                                    c, nmax, ct, g, cc, ldc, eps,
     $                                    err, fatal, nout, .true. )
                              errmax = max( errmax, err )
*                             If got really bad answer, report and
*                             return.
                              IF( fatal )
     $                           GO TO 120
                           END IF
*
   50                   CONTINUE
*
   60                CONTINUE
*
   70             CONTINUE
*
   80          CONTINUE
*
   90       CONTINUE
*
  100    CONTINUE
*
  110 CONTINUE
*
*     Report result.
*
      IF( errmax.LT.thresh )THEN
         WRITE( nout, fmt = 9999 )sname, nc
      ELSE
         WRITE( nout, fmt = 9997 )sname, nc, errmax
      END IF
      GO TO 130
*
  120 CONTINUE
      WRITE( nout, fmt = 9996 )sname
      WRITE( nout, fmt = 9995 )nc, sname, transa, transb, m, n, k,
     $   alpha, lda, ldb, beta, ldc
*
  130 CONTINUE
      RETURN
*
 9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
     $      'S)' )
 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
     $      'ANGED INCORRECTLY *******' )
 9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
     $      ' - SUSPECT *******' )
 9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
 9995 FORMAT( 1x, i6, ': ', a6, '(''', a1, ''',''', a1, ''',',
     $      3( i3, ',' ), '(', f4.1, ',', f4.1, '), a,', I3, ', b,', I3,
     $      ',(', F4.1, ',', F4.1, '), c,', I3, ').' )
 9994 FORMAT( ' ******* fatal error - error-EXIT taken on valid CALL *',
     $      '******' )
*
*     End of ZCHK1
*

zchk2()

subroutine zchk2	(	character*6	sname,
		double precision	eps,
		double precision	thresh,
		integer	nout,
		integer	ntra,
		logical	trace,
		logical	rewi,
		logical	fatal,
		integer	nidim,
		integer, dimension( nidim )	idim,
		integer	nalf,
		complex*16, dimension( nalf )	alf,
		integer	nbet,
		complex*16, dimension( nbet )	bet,
		integer	nmax,
		complex*16, dimension( nmax, nmax )	a,
		complex*16, dimension( nmax*nmax )	aa,
		complex*16, dimension( nmax*nmax )	as,
		complex*16, dimension( nmax, nmax )	b,
		complex*16, dimension( nmax*nmax )	bb,
		complex*16, dimension( nmax*nmax )	bs,
		complex*16, dimension( nmax, nmax )	c,
		complex*16, dimension( nmax*nmax )	cc,
		complex*16, dimension( nmax*nmax )	cs,
		complex*16, dimension( nmax )	ct,
		double precision, dimension( nmax )	g )

Definition at line 689 of file zblat3.f.

*
*  Tests ZHEMM and ZSYMM.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO
      parameter( zero = ( 0.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RZERO
      parameter( rzero = 0.0d0 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   EPS, THRESH
      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
      LOGICAL            FATAL, REWI, TRACE
      CHARACTER*6        SNAME
*     .. Array Arguments ..
      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
     $                   CS( NMAX*NMAX ), CT( NMAX )
      DOUBLE PRECISION   G( NMAX )
      INTEGER            IDIM( NIDIM )
*     .. Local Scalars ..
      COMPLEX*16         ALPHA, ALS, BETA, BLS
      DOUBLE PRECISION   ERR, ERRMAX
      INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
     $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
     $                   NARGS, NC, NS
      LOGICAL            CONJ, LEFT, NULL, RESET, SAME
      CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
      CHARACTER*2        ICHS, ICHU
*     .. Local Arrays ..
      LOGICAL            ISAME( 13 )
*     .. External Functions ..
      LOGICAL            LZE, LZERES
      EXTERNAL           lze, lzeres
*     .. External Subroutines ..
      EXTERNAL           zhemm, zmake, zmmch, zsymm
*     .. Intrinsic Functions ..
      INTRINSIC          max
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
*     .. Common blocks ..
      COMMON             /infoc/infot, noutc, ok, lerr
*     .. Data statements ..
      DATA               ichs/'LR'/, ichu/'UL'/
*     .. Executable Statements ..
      conj = sname( 2: 3 ).EQ.'HE'
*
      nargs = 12
      nc = 0
      reset = .true.
      errmax = rzero
*
      DO 100 im = 1, nidim
         m = idim( im )
*
         DO 90 in = 1, nidim
            n = idim( in )
*           Set LDC to 1 more than minimum value if room.
            ldc = m
            IF( ldc.LT.nmax )
     $         ldc = ldc + 1
*           Skip tests if not enough room.
            IF( ldc.GT.nmax )
     $         GO TO 90
            lcc = ldc*n
            null = n.LE.0.OR.m.LE.0
*           Set LDB to 1 more than minimum value if room.
            ldb = m
            IF( ldb.LT.nmax )
     $         ldb = ldb + 1
*           Skip tests if not enough room.
            IF( ldb.GT.nmax )
     $         GO TO 90
            lbb = ldb*n
*
*           Generate the matrix B.
*
            CALL zmake( 'ge', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
     $                  ZERO )
*
            DO 80 ICS = 1, 2
               SIDE = ICHS( ICS: ICS )
.EQ.               LEFT = SIDE'l'
*
               IF( LEFT )THEN
                  NA = M
               ELSE
                  NA = N
               END IF
*              Set LDA to 1 more than minimum value if room.
               LDA = NA
.LT.               IF( LDANMAX )
     $            LDA = LDA + 1
*              Skip tests if not enough room.
.GT.               IF( LDANMAX )
     $            GO TO 80
               LAA = LDA*NA
*
               DO 70 ICU = 1, 2
                  UPLO = ICHU( ICU: ICU )
*
*                 Generate the hermitian or symmetric matrix A.
*
                  CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', NA, NA, A, NMAX,
     $                        AA, LDA, RESET, ZERO )
*
                  DO 60 IA = 1, NALF
                     ALPHA = ALF( IA )
*
                     DO 50 IB = 1, NBET
                        BETA = BET( IB )
*
*                       Generate the matrix C.
*
                        CALL ZMAKE( 'ge', ' ', ' ', M, N, C, NMAX, CC,
     $                              LDC, RESET, ZERO )
*
                        NC = NC + 1
*
*                       Save every datum before calling the
*                       subroutine.
*
                        SIDES = SIDE
                        UPLOS = UPLO
                        MS = M
                        NS = N
                        ALS = ALPHA
                        DO 10 I = 1, LAA
                           AS( I ) = AA( I )
   10                   CONTINUE
                        LDAS = LDA
                        DO 20 I = 1, LBB
                           BS( I ) = BB( I )
   20                   CONTINUE
                        LDBS = LDB
                        BLS = BETA
                        DO 30 I = 1, LCC
                           CS( I ) = CC( I )
   30                   CONTINUE
                        LDCS = LDC
*
*                       Call the subroutine.
*
                        IF( TRACE )
     $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
     $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
                        IF( REWI )
     $                     REWIND NTRA
                        IF( CONJ )THEN
                           CALL ZHEMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
     $                                 BB, LDB, BETA, CC, LDC )
                        ELSE
                           CALL ZSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
     $                                 BB, LDB, BETA, CC, LDC )
                        END IF
*
*                       Check if error-exit was taken incorrectly.
*
.NOT.                        IF( OK )THEN
                           WRITE( NOUT, FMT = 9994 )
                           FATAL = .TRUE.
                           GO TO 110
                        END IF
*
*                       See what data changed inside subroutines.
*
.EQ.                        ISAME( 1 ) = SIDESSIDE
.EQ.                        ISAME( 2 ) = UPLOSUPLO
.EQ.                        ISAME( 3 ) = MSM
.EQ.                        ISAME( 4 ) = NSN
.EQ.                        ISAME( 5 ) = ALSALPHA
                        ISAME( 6 ) = LZE( AS, AA, LAA )
.EQ.                        ISAME( 7 ) = LDASLDA
                        ISAME( 8 ) = LZE( BS, BB, LBB )
.EQ.                        ISAME( 9 ) = LDBSLDB
.EQ.                        ISAME( 10 ) = BLSBETA
                        IF( NULL )THEN
                           ISAME( 11 ) = LZE( CS, CC, LCC )
                        ELSE
                           ISAME( 11 ) = LZERES( 'ge', ' ', m, n, cs,
     $                                   cc, ldc )
                        END IF
                        isame( 12 ) = ldcs.EQ.ldc
*
*                       If data was incorrectly changed, report and
*                       return.
*
                        same = .true.
                        DO 40 i = 1, nargs
                           same = same.AND.isame( i )
                           IF( .NOT.isame( i ) )
     $                        WRITE( nout, fmt = 9998 )i
   40                   CONTINUE
                        IF( .NOT.same )THEN
                           fatal = .true.
                           GO TO 110
                        END IF
*
                        IF( .NOT.null )THEN
*
*                          Check the result.
*
                           IF( left )THEN
                              CALL zmmch( 'N', 'N', m, n, m, alpha, a,
     $                                    nmax, b, nmax, beta, c, nmax,
     $                                    ct, g, cc, ldc, eps, err,
     $                                    fatal, nout, .true. )
                           ELSE
                              CALL zmmch( 'N', 'N', m, n, n, alpha, b,
     $                                    nmax, a, nmax, beta, c, nmax,
     $                                    ct, g, cc, ldc, eps, err,
     $                                    fatal, nout, .true. )
                           END IF
                           errmax = max( errmax, err )
*                          If got really bad answer, report and
*                          return.
                           IF( fatal )
     $                        GO TO 110
                        END IF
*
   50                CONTINUE
*
   60             CONTINUE
*
   70          CONTINUE
*
   80       CONTINUE
*
   90    CONTINUE
*
  100 CONTINUE
*
*     Report result.
*
      IF( errmax.LT.thresh )THEN
         WRITE( nout, fmt = 9999 )sname, nc
      ELSE
         WRITE( nout, fmt = 9997 )sname, nc, errmax
      END IF
      GO TO 120
*
  110 CONTINUE
      WRITE( nout, fmt = 9996 )sname
      WRITE( nout, fmt = 9995 )nc, sname, side, uplo, m, n, alpha, lda,
     $   ldb, beta, ldc
*
  120 CONTINUE
      RETURN
*
 9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
     $      'S)' )
 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
     $      'ANGED INCORRECTLY *******' )
 9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
     $      ' - SUSPECT *******' )
 9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
 9995 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
     $      '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ',(', f4.1,
     $      ',', f4.1, '), C,', i3, ')    .' )
 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
     $      '******' )
*
*     End of ZCHK2
*

zchk3()

subroutine zchk3	(	character*6	sname,
		double precision	eps,
		double precision	thresh,
		integer	nout,
		integer	ntra,
		logical	trace,
		logical	rewi,
		logical	fatal,
		integer	nidim,
		integer, dimension( nidim )	idim,
		integer	nalf,
		complex*16, dimension( nalf )	alf,
		integer	nmax,
		complex*16, dimension( nmax, nmax )	a,
		complex*16, dimension( nmax*nmax )	aa,
		complex*16, dimension( nmax*nmax )	as,
		complex*16, dimension( nmax, nmax )	b,
		complex*16, dimension( nmax*nmax )	bb,
		complex*16, dimension( nmax*nmax )	bs,
		complex*16, dimension( nmax )	ct,
		double precision, dimension( nmax )	g,
		complex*16, dimension( nmax, nmax )	c )

Definition at line 968 of file zblat3.f.

*
*  Tests ZTRMM and ZTRSM.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO, ONE
      parameter( zero = ( 0.0d0, 0.0d0 ),
     $                   one = ( 1.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RZERO
      parameter( rzero = 0.0d0 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   EPS, THRESH
      INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
      LOGICAL            FATAL, REWI, TRACE
      CHARACTER*6        SNAME
*     .. Array Arguments ..
      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
     $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
     $                   C( NMAX, NMAX ), CT( NMAX )
      DOUBLE PRECISION   G( NMAX )
      INTEGER            IDIM( NIDIM )
*     .. Local Scalars ..
      COMPLEX*16         ALPHA, ALS
      DOUBLE PRECISION   ERR, ERRMAX
      INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
     $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
     $                   NS
      LOGICAL            LEFT, NULL, RESET, SAME
      CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
     $                   UPLOS
      CHARACTER*2        ICHD, ICHS, ICHU
      CHARACTER*3        ICHT
*     .. Local Arrays ..
      LOGICAL            ISAME( 13 )
*     .. External Functions ..
      LOGICAL            LZE, LZERES
      EXTERNAL           lze, lzeres
*     .. External Subroutines ..
      EXTERNAL           zmake, zmmch, ztrmm, ztrsm
*     .. Intrinsic Functions ..
      INTRINSIC          max
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
*     .. Common blocks ..
      COMMON             /infoc/infot, noutc, ok, lerr
*     .. Data statements ..
      DATA               ichu/'UL'/, icht/'NTC'/, ichd/'UN'/, ichs/'lr'/
*     .. Executable Statements ..
*
      NARGS = 11
      NC = 0
      RESET = .TRUE.
      ERRMAX = RZERO
*     Set up zero matrix for ZMMCH.
      DO 20 J = 1, NMAX
         DO 10 I = 1, NMAX
            C( I, J ) = ZERO
   10    CONTINUE
   20 CONTINUE
*
      DO 140 IM = 1, NIDIM
         M = IDIM( IM )
*
         DO 130 IN = 1, NIDIM
            N = IDIM( IN )
*           Set LDB to 1 more than minimum value if room.
            LDB = M
.LT.            IF( LDBNMAX )
     $         LDB = LDB + 1
*           Skip tests if not enough room.
.GT.            IF( LDBNMAX )
     $         GO TO 130
            LBB = LDB*N
.LE..OR..LE.            NULL = M0N0
*
            DO 120 ICS = 1, 2
               SIDE = ICHS( ICS: ICS )
.EQ.               LEFT = SIDE'l'
               IF( LEFT )THEN
                  NA = M
               ELSE
                  NA = N
               END IF
*              Set LDA to 1 more than minimum value if room.
               LDA = NA
.LT.               IF( LDANMAX )
     $            LDA = LDA + 1
*              Skip tests if not enough room.
.GT.               IF( LDANMAX )
     $            GO TO 130
               LAA = LDA*NA
*
               DO 110 ICU = 1, 2
                  UPLO = ICHU( ICU: ICU )
*
                  DO 100 ICT = 1, 3
                     TRANSA = ICHT( ICT: ICT )
*
                     DO 90 ICD = 1, 2
                        DIAG = ICHD( ICD: ICD )
*
                        DO 80 IA = 1, NALF
                           ALPHA = ALF( IA )
*
*                          Generate the matrix A.
*
                           CALL ZMAKE( 'tr', UPLO, DIAG, NA, NA, A,
     $                                 NMAX, AA, LDA, RESET, ZERO )
*
*                          Generate the matrix B.
*
                           CALL ZMAKE( 'ge', ' ', ' ', M, N, B, NMAX,
     $                                 BB, LDB, RESET, ZERO )
*
                           NC = NC + 1
*
*                          Save every datum before calling the
*                          subroutine.
*
                           SIDES = SIDE
                           UPLOS = UPLO
                           TRANAS = TRANSA
                           DIAGS = DIAG
                           MS = M
                           NS = N
                           ALS = ALPHA
                           DO 30 I = 1, LAA
                              AS( I ) = AA( I )
   30                      CONTINUE
                           LDAS = LDA
                           DO 40 I = 1, LBB
                              BS( I ) = BB( I )
   40                      CONTINUE
                           LDBS = LDB
*
*                          Call the subroutine.
*
.EQ.                           IF( SNAME( 4: 5 )'mm' )THEN
                              IF( TRACE )
     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
     $                           LDA, LDB
                              IF( REWI )
     $                           REWIND NTRA
                              CALL ZTRMM( SIDE, UPLO, TRANSA, DIAG, M,
     $                                    N, ALPHA, AA, LDA, BB, LDB )
.EQ.                           ELSE IF( SNAME( 4: 5 )'sm' )THEN
                              IF( TRACE )
     $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
     $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
     $                           LDA, LDB
                              IF( REWI )
     $                           REWIND NTRA
                              CALL ZTRSM( SIDE, UPLO, TRANSA, DIAG, M,
     $                                    N, ALPHA, AA, LDA, BB, LDB )
                           END IF
*
*                          Check if error-exit was taken incorrectly.
*
.NOT.                           IF( OK )THEN
                              WRITE( NOUT, FMT = 9994 )
                              FATAL = .TRUE.
                              GO TO 150
                           END IF
*
*                          See what data changed inside subroutines.
*
.EQ.                           ISAME( 1 ) = SIDESSIDE
.EQ.                           ISAME( 2 ) = UPLOSUPLO
.EQ.                           ISAME( 3 ) = TRANASTRANSA
.EQ.                           ISAME( 4 ) = DIAGSDIAG
.EQ.                           ISAME( 5 ) = MSM
.EQ.                           ISAME( 6 ) = NSN
.EQ.                           ISAME( 7 ) = ALSALPHA
                           ISAME( 8 ) = LZE( AS, AA, LAA )
.EQ.                           ISAME( 9 ) = LDASLDA
                           IF( NULL )THEN
                              ISAME( 10 ) = LZE( BS, BB, LBB )
                           ELSE
                              ISAME( 10 ) = LZERES( 'ge', ' ', M, N, BS,
     $                                      BB, LDB )
                           END IF
.EQ.                           ISAME( 11 ) = LDBSLDB
*
*                          If data was incorrectly changed, report and
*                          return.
*
                           SAME = .TRUE.
                           DO 50 I = 1, NARGS
.AND.                              SAME = SAMEISAME( I )
.NOT.                              IF( ISAME( I ) )
     $                           WRITE( NOUT, FMT = 9998 )I
   50                      CONTINUE
.NOT.                           IF( SAME )THEN
                              FATAL = .TRUE.
                              GO TO 150
                           END IF
*
.NOT.                           IF( NULL )THEN
.EQ.                              IF( SNAME( 4: 5 )'mm' )THEN
*
*                                Check the result.
*
                                 IF( LEFT )THEN
                                    CALL ZMMCH( TRANSA, 'n', M, N, M,
     $                                          ALPHA, A, NMAX, B, NMAX,
     $                                          ZERO, C, NMAX, CT, G,
     $                                          BB, LDB, EPS, ERR,
     $                                          FATAL, NOUT, .TRUE. )
                                 ELSE
                                    CALL ZMMCH( 'n', TRANSA, M, N, N,
     $                                          ALPHA, B, NMAX, A, NMAX,
     $                                          ZERO, C, NMAX, CT, G,
     $                                          BB, LDB, EPS, ERR,
     $                                          FATAL, NOUT, .TRUE. )
                                 END IF
.EQ.                              ELSE IF( SNAME( 4: 5 )'sm' )THEN
*
*                                Compute approximation to original
*                                matrix.
*
                                 DO 70 J = 1, N
                                    DO 60 I = 1, M
                                       C( I, J ) = BB( I + ( J - 1 )*
     $                                             LDB )
                                       BB( I + ( J - 1 )*LDB ) = ALPHA*
     $                                    B( I, J )
   60                               CONTINUE
   70                            CONTINUE
*
                                 IF( LEFT )THEN
                                    CALL ZMMCH( TRANSA, 'n', M, N, M,
     $                                          ONE, A, NMAX, C, NMAX,
     $                                          ZERO, B, NMAX, CT, G,
     $                                          BB, LDB, EPS, ERR,
     $                                          FATAL, NOUT, .FALSE. )
                                 ELSE
                                    CALL ZMMCH( 'n', TRANSA, M, N, N,
     $                                          ONE, C, NMAX, A, NMAX,
     $                                          ZERO, B, NMAX, CT, G,
     $                                          BB, LDB, EPS, ERR,
     $                                          FATAL, NOUT, .FALSE. )
                                 END IF
                              END IF
                              ERRMAX = MAX( ERRMAX, ERR )
*                             If got really bad answer, report and
*                             return.
                              IF( FATAL )
     $                           GO TO 150
                           END IF
*
   80                   CONTINUE
*
   90                CONTINUE
*
  100             CONTINUE
*
  110          CONTINUE
*
  120       CONTINUE
*
  130    CONTINUE
*
  140 CONTINUE
*
*     Report result.
*
.LT.      IF( ERRMAXTHRESH )THEN
         WRITE( NOUT, FMT = 9999 )SNAME, NC
      ELSE
         WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
      END IF
      GO TO 160
*
  150 CONTINUE
      WRITE( NOUT, FMT = 9996 )SNAME
      WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
     $   N, ALPHA, LDA, LDB
*
  160 CONTINUE
      RETURN
*
 9999 FORMAT( ' ', A6, ' passed the computational tests(', I6, ' call',
     $      's)' )
 9998 FORMAT( ' ******* fatal error - PARAMETER number ', I2, ' was ch',
     $      'anged incorrectly *******' )
 9997 FORMAT( ' ', A6, ' completed the computational tests(', I6, ' c',
     $      'alls)', /' ******* but with maximum test ratio', F8.2,
     $      ' - suspect *******' )
 9996 FORMAT( ' ******* ', A6, ' failed on CALL number:' )
 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
     $      '(', F4.1, ',', F4.1, '), a,', I3, ', b,', I3, ')         ',
     $      '      .' )
 9994 FORMAT( ' ******* fatal error - error-EXIT taken on valid CALL *',
     $      '******' )
*
*     End of ZCHK3
*

zchk4()

subroutine zchk4	(	character*6	sname,
		double precision	eps,
		double precision	thresh,
		integer	nout,
		integer	ntra,
		logical	trace,
		logical	rewi,
		logical	fatal,
		integer	nidim,
		integer, dimension( nidim )	idim,
		integer	nalf,
		complex*16, dimension( nalf )	alf,
		integer	nbet,
		complex*16, dimension( nbet )	bet,
		integer	nmax,
		complex*16, dimension( nmax, nmax )	a,
		complex*16, dimension( nmax*nmax )	aa,
		complex*16, dimension( nmax*nmax )	as,
		complex*16, dimension( nmax, nmax )	b,
		complex*16, dimension( nmax*nmax )	bb,
		complex*16, dimension( nmax*nmax )	bs,
		complex*16, dimension( nmax, nmax )	c,
		complex*16, dimension( nmax*nmax )	cc,
		complex*16, dimension( nmax*nmax )	cs,
		complex*16, dimension( nmax )	ct,
		double precision, dimension( nmax )	g )

Definition at line 1279 of file zblat3.f.

*
*  Tests ZHERK and ZSYRK.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO
      parameter( zero = ( 0.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RONE, RZERO
      parameter( rone = 1.0d0, rzero = 0.0d0 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   EPS, THRESH
      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
      LOGICAL            FATAL, REWI, TRACE
      CHARACTER*6        SNAME
*     .. Array Arguments ..
      COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
     $                   CS( NMAX*NMAX ), CT( NMAX )
      DOUBLE PRECISION   G( NMAX )
      INTEGER            IDIM( NIDIM )
*     .. Local Scalars ..
      COMPLEX*16         ALPHA, ALS, BETA, BETS
      DOUBLE PRECISION   ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
     $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
     $                   NARGS, NC, NS
      LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
      CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
      CHARACTER*2        ICHT, ICHU
*     .. Local Arrays ..
      LOGICAL            ISAME( 13 )
*     .. External Functions ..
      LOGICAL            LZE, LZERES
      EXTERNAL           lze, lzeres
*     .. External Subroutines ..
      EXTERNAL           zherk, zmake, zmmch, zsyrk
*     .. Intrinsic Functions ..
      INTRINSIC          dcmplx, max, dble
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
*     .. Common blocks ..
      COMMON             /infoc/infot, noutc, ok, lerr
*     .. Data statements ..
      DATA               icht/'NC'/, ichu/'UL'/
*     .. Executable Statements ..
      conj = sname( 2: 3 ).EQ.'HE'
*
      nargs = 10
      nc = 0
      reset = .true.
      errmax = rzero
*
      DO 100 in = 1, nidim
         n = idim( in )
*        Set LDC to 1 more than minimum value if room.
         ldc = n
         IF( ldc.LT.nmax )
     $      ldc = ldc + 1
*        Skip tests if not enough room.
         IF( ldc.GT.nmax )
     $      GO TO 100
         lcc = ldc*n
*
         DO 90 ik = 1, nidim
            k = idim( ik )
*
            DO 80 ict = 1, 2
               trans = icht( ict: ict )
               tran = trans.EQ.'C'
               IF( tran.AND..NOT.conj )
     $            trans = 'T'
               IF( tran )THEN
                  ma = k
                  na = n
               ELSE
                  ma = n
                  na = k
               END IF
*              Set LDA to 1 more than minimum value if room.
               lda = ma
               IF( lda.LT.nmax )
     $            lda = lda + 1
*              Skip tests if not enough room.
               IF( lda.GT.nmax )
     $            GO TO 80
               laa = lda*na
*
*              Generate the matrix A.
*
               CALL zmake( 'GE', ' ', ' ', ma, na, a, nmax, aa, lda,
     $                     reset, zero )
*
               DO 70 icu = 1, 2
                  uplo = ichu( icu: icu )
                  upper = uplo.EQ.'U'
*
                  DO 60 ia = 1, nalf
                     alpha = alf( ia )
                     IF( conj )THEN
                        ralpha = dble( alpha )
                        alpha = dcmplx( ralpha, rzero )
                     END IF
*
                     DO 50 ib = 1, nbet
                        beta = bet( ib )
                        IF( conj )THEN
                           rbeta = dble( beta )
                           beta = dcmplx( rbeta, rzero )
                        END IF
                        null = n.LE.0
                        IF( conj )
     $                     null = null.OR.( ( k.LE.0.OR.ralpha.EQ.
     $                            rzero ).AND.rbeta.EQ.rone )
*
*                       Generate the matrix C.
*
                        CALL zmake( sname( 2: 3 ), uplo, ' ', n, n, c,
     $                              nmax, cc, ldc, reset, zero )
*
                        nc = nc + 1
*
*                       Save every datum before calling the subroutine.
*
                        uplos = uplo
                        transs = trans
                        ns = n
                        ks = k
                        IF( conj )THEN
                           rals = ralpha
                        ELSE
                           als = alpha
                        END IF
                        DO 10 i = 1, laa
                           as( i ) = aa( i )
   10                   CONTINUE
                        ldas = lda
                        IF( conj )THEN
                           rbets = rbeta
                        ELSE
                           bets = beta
                        END IF
                        DO 20 i = 1, lcc
                           cs( i ) = cc( i )
   20                   CONTINUE
                        ldcs = ldc
*
*                       Call the subroutine.
*
                        IF( conj )THEN
                           IF( trace )
     $                        WRITE( ntra, fmt = 9994 )nc, sname, uplo,
     $                        trans, n, k, ralpha, lda, rbeta, ldc
                           IF( rewi )
     $                        rewind ntra
                           CALL zherk( uplo, trans, n, k, ralpha, aa,
     $                                 lda, rbeta, cc, ldc )
                        ELSE
                           IF( trace )
     $                        WRITE( ntra, fmt = 9993 )nc, sname, uplo,
     $                        trans, n, k, alpha, lda, beta, ldc
                           IF( rewi )
     $                        rewind ntra
                           CALL zsyrk( uplo, trans, n, k, alpha, aa,
     $                                 lda, beta, cc, ldc )
                        END IF
*
*                       Check if error-exit was taken incorrectly.
*
                        IF( .NOT.ok )THEN
                           WRITE( nout, fmt = 9992 )
                           fatal = .true.
                           GO TO 120
                        END IF
*
*                       See what data changed inside subroutines.
*
                        isame( 1 ) = uplos.EQ.uplo
                        isame( 2 ) = transs.EQ.trans
                        isame( 3 ) = ns.EQ.n
                        isame( 4 ) = ks.EQ.k
                        IF( conj )THEN
                           isame( 5 ) = rals.EQ.ralpha
                        ELSE
                           isame( 5 ) = als.EQ.alpha
                        END IF
                        isame( 6 ) = lze( as, aa, laa )
                        isame( 7 ) = ldas.EQ.lda
                        IF( conj )THEN
                           isame( 8 ) = rbets.EQ.rbeta
                        ELSE
                           isame( 8 ) = bets.EQ.beta
                        END IF
                        IF( null )THEN
                           isame( 9 ) = lze( cs, cc, lcc )
                        ELSE
                           isame( 9 ) = lzeres( sname( 2: 3 ), uplo, n,
     $                                  n, cs, cc, ldc )
                        END IF
                        isame( 10 ) = ldcs.EQ.ldc
*
*                       If data was incorrectly changed, report and
*                       return.
*
                        same = .true.
                        DO 30 i = 1, nargs
                           same = same.AND.isame( i )
                           IF( .NOT.isame( i ) )
     $                        WRITE( nout, fmt = 9998 )i
   30                   CONTINUE
                        IF( .NOT.same )THEN
                           fatal = .true.
                           GO TO 120
                        END IF
*
                        IF( .NOT.null )THEN
*
*                          Check the result column by column.
*
                           IF( conj )THEN
                              transt = 'C'
                           ELSE
                              transt = 'T'
                           END IF
                           jc = 1
                           DO 40 j = 1, n
                              IF( upper )THEN
                                 jj = 1
                                 lj = j
                              ELSE
                                 jj = j
                                 lj = n - j + 1
                              END IF
                              IF( tran )THEN
                                 CALL zmmch( transt, 'N', lj, 1, k,
     $                                       alpha, a( 1, jj ), nmax,
     $                                       a( 1, j ), nmax, beta,
     $                                       c( jj, j ), nmax, ct, g,
     $                                       cc( jc ), ldc, eps, err,
     $                                       fatal, nout, .true. )
                              ELSE
                                 CALL zmmch( 'N', transt, lj, 1, k,
     $                                       alpha, a( jj, 1 ), nmax,
     $                                       a( j, 1 ), nmax, beta,
     $                                       c( jj, j ), nmax, ct, g,
     $                                       cc( jc ), ldc, eps, err,
     $                                       fatal, nout, .true. )
                              END IF
                              IF( upper )THEN
                                 jc = jc + ldc
                              ELSE
                                 jc = jc + ldc + 1
                              END IF
                              errmax = max( errmax, err )
*                             If got really bad answer, report and
*                             return.
                              IF( fatal )
     $                           GO TO 110
   40                      CONTINUE
                        END IF
*
   50                CONTINUE
*
   60             CONTINUE
*
   70          CONTINUE
*
   80       CONTINUE
*
   90    CONTINUE
*
  100 CONTINUE
*
*     Report result.
*
      IF( errmax.LT.thresh )THEN
         WRITE( nout, fmt = 9999 )sname, nc
      ELSE
         WRITE( nout, fmt = 9997 )sname, nc, errmax
      END IF
      GO TO 130
*
  110 CONTINUE
      IF( n.GT.1 )
     $   WRITE( nout, fmt = 9995 )j
*
  120 CONTINUE
      WRITE( nout, fmt = 9996 )sname
      IF( conj )THEN
         WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, ralpha,
     $      lda, rbeta, ldc
      ELSE
         WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, n, k, alpha,
     $      lda, beta, ldc
      END IF
*
  130 CONTINUE
      RETURN
*
 9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' call',
     $      's)' )
 9998 FORMAT( ' ******* fatal error - PARAMETER number ', I2, ' was ch',
     $      'anged incorrectly *******' )
 9997 FORMAT( ' ', A6, ' completed the computational tests(', I6, ' c',
     $      'alls)', /' ******* but with maximum test ratio', F8.2,
     $      ' - suspect *******' )
 9996 FORMAT( ' ******* ', A6, ' failed on CALL number:' )
 9995 FORMAT( '      these are the results for column ', I3 )
 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
     $      f4.1, ', A,', i3, ',', f4.1, ', C,', i3, ')               ',
     $      '          .' )
 9993 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
     $      '(', f4.1, ',', f4.1, ') , A,', i3, ',(', f4.1, ',', f4.1,
     $      '), C,', i3, ')          .' )
 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
     $      '******' )
*
*     End of ZCHK4
*

zchk5()

subroutine zchk5	(	character*6	sname,
		double precision	eps,
		double precision	thresh,
		integer	nout,
		integer	ntra,
		logical	trace,
		logical	rewi,
		logical	fatal,
		integer	nidim,
		integer, dimension( nidim )	idim,
		integer	nalf,
		complex*16, dimension( nalf )	alf,
		integer	nbet,
		complex*16, dimension( nbet )	bet,
		integer	nmax,
		complex*16, dimension( 2*nmax*nmax )	ab,
		complex*16, dimension( nmax*nmax )	aa,
		complex*16, dimension( nmax*nmax )	as,
		complex*16, dimension( nmax*nmax )	bb,
		complex*16, dimension( nmax*nmax )	bs,
		complex*16, dimension( nmax, nmax )	c,
		complex*16, dimension( nmax*nmax )	cc,
		complex*16, dimension( nmax*nmax )	cs,
		complex*16, dimension( nmax )	ct,
		double precision, dimension( nmax )	g,
		complex*16, dimension( 2*nmax )	w )

Definition at line 1611 of file zblat3.f.

*
*  Tests ZHER2K and ZSYR2K.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO, ONE
      parameter( zero = ( 0.0d0, 0.0d0 ),
     $                   one = ( 1.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RONE, RZERO
      parameter( rone = 1.0d0, rzero = 0.0d0 )
*     .. Scalar Arguments ..
      DOUBLE PRECISION   EPS, THRESH
      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
      LOGICAL            FATAL, REWI, TRACE
      CHARACTER*6        SNAME
*     .. Array Arguments ..
      COMPLEX*16         AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
     $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
     $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
     $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
     $                   W( 2*NMAX )
      DOUBLE PRECISION   G( NMAX )
      INTEGER            IDIM( NIDIM )
*     .. Local Scalars ..
      COMPLEX*16         ALPHA, ALS, BETA, BETS
      DOUBLE PRECISION   ERR, ERRMAX, RBETA, RBETS
      INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
     $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
     $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
      LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
      CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
      CHARACTER*2        ICHT, ICHU
*     .. Local Arrays ..
      LOGICAL            ISAME( 13 )
*     .. External Functions ..
      LOGICAL            LZE, LZERES
      EXTERNAL           lze, lzeres
*     .. External Subroutines ..
      EXTERNAL           zher2k, zmake, zmmch, zsyr2k
*     .. Intrinsic Functions ..
      INTRINSIC          dcmplx, dconjg, max, dble
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
*     .. Common blocks ..
      COMMON             /infoc/infot, noutc, ok, lerr
*     .. Data statements ..
      DATA               icht/'NC'/, ichu/'UL'/
*     .. Executable Statements ..
      conj = sname( 2: 3 ).EQ.'HE'
*
      nargs = 12
      nc = 0
      reset = .true.
      errmax = rzero
*
      DO 130 in = 1, nidim
         n = idim( in )
*        Set LDC to 1 more than minimum value if room.
         ldc = n
         IF( ldc.LT.nmax )
     $      ldc = ldc + 1
*        Skip tests if not enough room.
         IF( ldc.GT.nmax )
     $      GO TO 130
         lcc = ldc*n
*
         DO 120 ik = 1, nidim
            k = idim( ik )
*
            DO 110 ict = 1, 2
               trans = icht( ict: ict )
               tran = trans.EQ.'C'
               IF( tran.AND..NOT.conj )
     $            trans = 'T'
               IF( tran )THEN
                  ma = k
                  na = n
               ELSE
                  ma = n
                  na = k
               END IF
*              Set LDA to 1 more than minimum value if room.
               lda = ma
               IF( lda.LT.nmax )
     $            lda = lda + 1
*              Skip tests if not enough room.
               IF( lda.GT.nmax )
     $            GO TO 110
               laa = lda*na
*
*              Generate the matrix A.
*
               IF( tran )THEN
                  CALL zmake( 'GE', ' ', ' ', ma, na, ab, 2*nmax, aa,
     $                        lda, reset, zero )
               ELSE
                  CALL zmake( 'GE', ' ', ' ', ma, na, ab, nmax, aa, lda,
     $                        reset, zero )
               END IF
*
*              Generate the matrix B.
*
               ldb = lda
               lbb = laa
               IF( tran )THEN
                  CALL zmake( 'GE', ' ', ' ', ma, na, ab( k + 1 ),
     $                        2*nmax, bb, ldb, reset, zero )
               ELSE
                  CALL zmake( 'GE', ' ', ' ', ma, na, ab( k*nmax + 1 ),
     $                        nmax, bb, ldb, reset, zero )
               END IF
*
               DO 100 icu = 1, 2
                  uplo = ichu( icu: icu )
                  upper = uplo.EQ.'U'
*
                  DO 90 ia = 1, nalf
                     alpha = alf( ia )
*
                     DO 80 ib = 1, nbet
                        beta = bet( ib )
                        IF( conj )THEN
                           rbeta = dble( beta )
                           beta = dcmplx( rbeta, rzero )
                        END IF
                        null = n.LE.0
                        IF( conj )
     $                     null = null.OR.( ( k.LE.0.OR.alpha.EQ.
     $                            zero ).AND.rbeta.EQ.rone )
*
*                       Generate the matrix C.
*
                        CALL zmake( sname( 2: 3 ), uplo, ' ', n, n, c,
     $                              nmax, cc, ldc, reset, zero )
*
                        nc = nc + 1
*
*                       Save every datum before calling the subroutine.
*
                        uplos = uplo
                        transs = trans
                        ns = n
                        ks = k
                        als = alpha
                        DO 10 i = 1, laa
                           as( i ) = aa( i )
   10                   CONTINUE
                        ldas = lda
                        DO 20 i = 1, lbb
                           bs( i ) = bb( i )
   20                   CONTINUE
                        ldbs = ldb
                        IF( conj )THEN
                           rbets = rbeta
                        ELSE
                           bets = beta
                        END IF
                        DO 30 i = 1, lcc
                           cs( i ) = cc( i )
   30                   CONTINUE
                        ldcs = ldc
*
*                       Call the subroutine.
*
                        IF( conj )THEN
                           IF( trace )
     $                        WRITE( ntra, fmt = 9994 )nc, sname, uplo,
     $                        trans, n, k, alpha, lda, ldb, rbeta, ldc
                           IF( rewi )
     $                        rewind ntra
                           CALL zher2k( uplo, trans, n, k, alpha, aa,
     $                                  lda, bb, ldb, rbeta, cc, ldc )
                        ELSE
                           IF( trace )
     $                        WRITE( ntra, fmt = 9993 )nc, sname, uplo,
     $                        trans, n, k, alpha, lda, ldb, beta, ldc
                           IF( rewi )
     $                        rewind ntra
                           CALL zsyr2k( uplo, trans, n, k, alpha, aa,
     $                                  lda, bb, ldb, beta, cc, ldc )
                        END IF
*
*                       Check if error-exit was taken incorrectly.
*
                        IF( .NOT.ok )THEN
                           WRITE( nout, fmt = 9992 )
                           fatal = .true.
                           GO TO 150
                        END IF
*
*                       See what data changed inside subroutines.
*
                        isame( 1 ) = uplos.EQ.uplo
                        isame( 2 ) = transs.EQ.trans
                        isame( 3 ) = ns.EQ.n
                        isame( 4 ) = ks.EQ.k
                        isame( 5 ) = als.EQ.alpha
                        isame( 6 ) = lze( as, aa, laa )
                        isame( 7 ) = ldas.EQ.lda
                        isame( 8 ) = lze( bs, bb, lbb )
                        isame( 9 ) = ldbs.EQ.ldb
                        IF( conj )THEN
                           isame( 10 ) = rbets.EQ.rbeta
                        ELSE
                           isame( 10 ) = bets.EQ.beta
                        END IF
                        IF( null )THEN
                           isame( 11 ) = lze( cs, cc, lcc )
                        ELSE
                           isame( 11 ) = lzeres( 'HE', uplo, n, n, cs,
     $                                   cc, ldc )
                        END IF
                        isame( 12 ) = ldcs.EQ.ldc
*
*                       If data was incorrectly changed, report and
*                       return.
*
                        same = .true.
                        DO 40 i = 1, nargs
                           same = same.AND.isame( i )
                           IF( .NOT.isame( i ) )
     $                        WRITE( nout, fmt = 9998 )i
   40                   CONTINUE
                        IF( .NOT.same )THEN
                           fatal = .true.
                           GO TO 150
                        END IF
*
                        IF( .NOT.null )THEN
*
*                          Check the result column by column.
*
                           IF( conj )THEN
                              transt = 'C'
                           ELSE
                              transt = 'T'
                           END IF
                           jjab = 1
                           jc = 1
                           DO 70 j = 1, n
                              IF( upper )THEN
                                 jj = 1
                                 lj = j
                              ELSE
                                 jj = j
                                 lj = n - j + 1
                              END IF
                              IF( tran )THEN
                                 DO 50 i = 1, k
                                    w( i ) = alpha*ab( ( j - 1 )*2*
     $                                       nmax + k + i )
                                    IF( conj )THEN
                                       w( k + i ) = dconjg( alpha )*
     $                                              ab( ( j - 1 )*2*
     $                                              nmax + i )
                                    ELSE
                                       w( k + i ) = alpha*
     $                                              ab( ( j - 1 )*2*
     $                                              nmax + i )
                                    END IF
   50                            CONTINUE
                                 CALL zmmch( transt, 'N', lj, 1, 2*k,
     $                                       one, ab( jjab ), 2*nmax, w,
     $                                       2*nmax, beta, c( jj, j ),
     $                                       nmax, ct, g, cc( jc ), ldc,
     $                                       eps, err, fatal, nout,
     $                                       .true. )
                              ELSE
                                 DO 60 i = 1, k
                                    IF( conj )THEN
                                       w( i ) = alpha*dconjg( ab( ( k +
     $                                          i - 1 )*nmax + j ) )
                                       w( k + i ) = dconjg( alpha*
     $                                              ab( ( i - 1 )*nmax +
     $                                              j ) )
                                    ELSE
                                       w( i ) = alpha*ab( ( k + i - 1 )*
     $                                          nmax + j )
                                       w( k + i ) = alpha*
     $                                              ab( ( i - 1 )*nmax +
     $                                              j )
                                    END IF
   60                            CONTINUE
                                 CALL zmmch( 'N', 'N', lj, 1, 2*k, one,
     $                                       ab( jj ), nmax, w, 2*nmax,
     $                                       beta, c( jj, j ), nmax, ct,
     $                                       g, cc( jc ), ldc, eps, err,
     $                                       fatal, nout, .true. )
                              END IF
                              IF( upper )THEN
                                 jc = jc + ldc
                              ELSE
                                 jc = jc + ldc + 1
                                 IF( tran )
     $                              jjab = jjab + 2*nmax
                              END IF
                              errmax = max( errmax, err )
*                             If got really bad answer, report and
*                             return.
                              IF( fatal )
     $                           GO TO 140
   70                      CONTINUE
                        END IF
*
   80                CONTINUE
*
   90             CONTINUE
*
  100          CONTINUE
*
  110       CONTINUE
*
  120    CONTINUE
*
  130 CONTINUE
*
*     Report result.
*
      IF( errmax.LT.thresh )THEN
         WRITE( nout, fmt = 9999 )sname, nc
      ELSE
         WRITE( nout, fmt = 9997 )sname, nc, errmax
      END IF
      GO TO 160
*
  140 CONTINUE
      IF( n.GT.1 )
     $   WRITE( nout, fmt = 9995 )j
*
  150 CONTINUE
      WRITE( nout, fmt = 9996 )sname
      IF( conj )THEN
         WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, alpha,
     $      lda, ldb, rbeta, ldc
      ELSE
         WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, n, k, alpha,
     $      lda, ldb, beta, ldc
      END IF
*
  160 CONTINUE
      RETURN
*
 9999 FORMAT( ' ', a6, ' PASSED THE COMPUTATIONAL TESTS (', i6, ' CALL',
     $      'S)' )
 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', i2, ' WAS CH',
     $      'ANGED INCORRECTLY *******' )
 9997 FORMAT( ' ', a6, ' COMPLETED THE COMPUTATIONAL TESTS (', i6, ' C',
     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
     $      ' - SUSPECT *******' )
 9996 FORMAT( ' ******* ', a6, ' FAILED ON CALL NUMBER:' )
 9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', i3 )
 9994 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
     $      '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ',', f4.1,
     $      ', C,', i3, ')           .' )
 9993 FORMAT( 1x, i6, ': ', a6, '(', 2( '''', a1, ''',' ), 2( i3, ',' ),
     $      '(', f4.1, ',', f4.1, '), A,', i3, ', B,', i3, ',(', f4.1,
     $      ',', f4.1, '), C,', i3, ')    .' )
 9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
     $      '******' )
*
*     End of ZCHK5
*

zchke()

subroutine zchke	(	integer	isnum,
		character*6	srnamt,
		integer	nout )

Definition at line 1985 of file zblat3.f.

*
*  Tests the error exits from the Level 3 Blas.
*  Requires a special version of the error-handling routine XERBLA.
*  A, B and C should not need to be defined.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*  3-19-92:  Initialize ALPHA, BETA, RALPHA, and RBETA  (eca)
*  3-19-92:  Fix argument 12 in calls to ZSYMM and ZHEMM
*            with INFOT = 9  (eca)
*  10-9-00:  Declared INTRINSIC DCMPLX (susan)
*
*     .. Scalar Arguments ..
      INTEGER            ISNUM, NOUT
      CHARACTER*6        SRNAMT
*     .. Scalars in Common ..
      INTEGER            INFOT, NOUTC
      LOGICAL            LERR, OK
*     .. Parameters ..
      REAL               ONE, TWO
      parameter( one = 1.0d0, two = 2.0d0 )
*     .. Local Scalars ..
      COMPLEX*16         ALPHA, BETA
      DOUBLE PRECISION   RALPHA, RBETA
*     .. Local Arrays ..
      COMPLEX*16         A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
*     .. External Subroutines ..
      EXTERNAL           zgemm, zhemm, zher2k, zherk, chkxer, zsymm,
     $                   zsyr2k, zsyrk, ztrmm, ztrsm
*     .. Intrinsic Functions ..
      INTRINSIC          dcmplx
*     .. Common blocks ..
      COMMON             /infoc/infot, noutc, ok, lerr
*     .. Executable Statements ..
*     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
*     if anything is wrong.
      ok = .true.
*     LERR is set to .TRUE. by the special version of XERBLA each time
*     it is called, and is then tested and re-set by CHKXER.
      lerr = .false.
*
*     Initialize ALPHA, BETA, RALPHA, and RBETA.
*
      alpha = dcmplx( one, -one )
      beta = dcmplx( two, -two )
      ralpha = one
      rbeta = two
*
      GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
     $        90 )isnum
   10 infot = 1
      CALL zgemm( '/', 'N', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 1
      CALL zgemm( '/', 'C', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 1
      CALL zgemm( '/', 'T', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zgemm( 'N', '/', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zgemm( 'C', '/', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zgemm( 'T', '/', 0, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'N', 'N', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'N', 'C', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'N', 'T', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'C', 'N', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'C', 'C', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'C', 'T', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'T', 'N', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'T', 'C', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zgemm( 'T', 'T', -1, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'N', 'N', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'N', 'C', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'N', 'T', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'C', 'N', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'C', 'C', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'C', 'T', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'T', 'N', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'T', 'C', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zgemm( 'T', 'T', 0, -1, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'N', 'N', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'N', 'C', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'N', 'T', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'C', 'N', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'C', 'C', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'C', 'T', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'T', 'N', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'T', 'C', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL zgemm( 'T', 'T', 0, 0, -1, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'N', 'N', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'N', 'C', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'N', 'T', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'C', 'N', 0, 0, 2, alpha, a, 1, b, 2, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'C', 'C', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'C', 'T', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'T', 'N', 0, 0, 2, alpha, a, 1, b, 2, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'T', 'C', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 8
      CALL zgemm( 'T', 'T', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'N', 'N', 0, 0, 2, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'C', 'N', 0, 0, 2, alpha, a, 2, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'T', 'N', 0, 0, 2, alpha, a, 2, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'N', 'C', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'C', 'C', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'T', 'C', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'N', 'T', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'C', 'T', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zgemm( 'T', 'T', 0, 2, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'N', 'N', 2, 0, 0, alpha, a, 2, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'N', 'C', 2, 0, 0, alpha, a, 2, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'N', 'T', 2, 0, 0, alpha, a, 2, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'C', 'N', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'C', 'C', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'C', 'T', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'T', 'N', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'T', 'C', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 13
      CALL zgemm( 'T', 'T', 2, 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      GO TO 100
   20 infot = 1
      CALL zhemm( '/', 'U', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zhemm( 'L', '/', 0, 0, alpha, a, 1, b, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zhemm( 'l', 'u', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZHEMM( 'r', 'u', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZHEMM( 'l', 'l', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZHEMM( 'r', 'l', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZHEMM( 'l', 'u', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZHEMM( 'r', 'u', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZHEMM( 'l', 'l', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZHEMM( 'r', 'l', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHEMM( 'l', 'u', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHEMM( 'r', 'u', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHEMM( 'l', 'l', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHEMM( 'r', 'l', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHEMM( 'l', 'u', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHEMM( 'r', 'u', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHEMM( 'l', 'l', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHEMM( 'r', 'l', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHEMM( 'l', 'u', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHEMM( 'r', 'u', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHEMM( 'l', 'l', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHEMM( 'r', 'l', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      GO TO 100
   30 INFOT = 1
      CALL ZSYMM( '/', 'u', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 2
      CALL ZSYMM( 'l', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYMM( 'l', 'u', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYMM( 'r', 'u', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYMM( 'l', 'l', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYMM( 'r', 'l', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYMM( 'l', 'u', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYMM( 'r', 'u', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYMM( 'l', 'l', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYMM( 'r', 'l', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYMM( 'l', 'u', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYMM( 'r', 'u', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYMM( 'l', 'l', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYMM( 'r', 'l', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYMM( 'l', 'u', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYMM( 'r', 'u', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYMM( 'l', 'l', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYMM( 'r', 'l', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYMM( 'l', 'u', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYMM( 'r', 'u', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYMM( 'l', 'l', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYMM( 'r', 'l', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      GO TO 100
   40 INFOT = 1
      CALL ZTRMM( '/', 'u', 'n', 'n', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL ztrmm( 'L', '/', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL ztrmm( 'L', 'U', '/', 'N', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL ztrmm( 'L', 'U', 'N', '/', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'L', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'L', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'L', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'R', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'R', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'R', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'L', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'L', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'L', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'R', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'R', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrmm( 'R', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'L', 'U', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'L', 'U', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'L', 'U', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'R', 'U', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'R', 'U', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'R', 'U', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'L', 'L', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'L', 'L', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'L', 'L', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'R', 'L', 'N', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'R', 'L', 'C', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 6
      CALL ztrmm( 'R', 'L', 'T', 'N', 0, -1, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'R', 'U', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'R', 'U', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'R', 'U', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'R', 'L', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'R', 'L', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrmm( 'R', 'L', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrmm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrmm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrmm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrmm( 'R', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrmm( 'R', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrmm( 'r', 'u', 't', 'n', 2, 0, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 11
      CALL ZTRMM( 'l', 'l', 'n', 'n', 2, 0, ALPHA, A, 2, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 11
      CALL ZTRMM( 'l', 'l', 'c', 'n', 2, 0, ALPHA, A, 2, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 11
      CALL ZTRMM( 'l', 'l', 't', 'n', 2, 0, ALPHA, A, 2, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 11
      CALL ZTRMM( 'r', 'l', 'n', 'n', 2, 0, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 11
      CALL ZTRMM( 'r', 'l', 'c', 'n', 2, 0, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 11
      CALL ZTRMM( 'r', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      GO TO 100
   50 infot = 1
      CALL ztrsm( '/', 'U', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL ztrsm( 'L', '/', 'N', 'N', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL ztrsm( 'L', 'U', '/', 'N', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL ztrsm( 'L', 'U', 'N', '/', 0, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'L', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'L', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'L', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'R', 'U', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'R', 'U', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'R', 'U', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'L', 'L', 'N', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'L', 'L', 'C', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'L', 'L', 'T', 'N', -1, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 5
      CALL ztrsm( 'r', 'l', 'n', 'n', -1, 0, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 5
      CALL ZTRSM( 'r', 'l', 'c', 'n', -1, 0, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 5
      CALL ZTRSM( 'r', 'l', 't', 'n', -1, 0, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'l', 'u', 'n', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'l', 'u', 'c', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'l', 'u', 't', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'r', 'u', 'n', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'r', 'u', 'c', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'r', 'u', 't', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'l', 'l', 'n', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'l', 'l', 'c', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'l', 'l', 't', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'r', 'l', 'n', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'r', 'l', 'c', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 6
      CALL ZTRSM( 'r', 'l', 't', 'n', 0, -1, ALPHA, A, 1, B, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZTRSM( 'l', 'u', 'n', 'n', 2, 0, ALPHA, A, 1, B, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZTRSM( 'l', 'u', 'c', 'n', 2, 0, ALPHA, A, 1, B, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZTRSM( 'l', 'u', 't', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'R', 'U', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'R', 'U', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'R', 'U', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'R', 'L', 'N', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'R', 'L', 'C', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 9
      CALL ztrsm( 'R', 'L', 'T', 'N', 0, 2, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'L', 'U', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'L', 'U', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'L', 'U', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'R', 'U', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'R', 'U', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'R', 'U', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'L', 'L', 'N', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'L', 'L', 'C', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'L', 'L', 'T', 'N', 2, 0, alpha, a, 2, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'R', 'L', 'N', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'R', 'L', 'C', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 11
      CALL ztrsm( 'R', 'L', 'T', 'N', 2, 0, alpha, a, 1, b, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      GO TO 100
   60 infot = 1
      CALL zherk( '/', 'N', 0, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zherk( 'U', 'T', 0, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zherk( 'U', 'N', -1, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zherk( 'U', 'C', -1, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zherk( 'L', 'N', -1, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zherk( 'L', 'C', -1, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zherk( 'U', 'N', 0, -1, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zherk( 'U', 'C', 0, -1, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zherk( 'L', 'N', 0, -1, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zherk( 'L', 'C', 0, -1, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zherk( 'U', 'N', 2, 0, ralpha, a, 1, rbeta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zherk( 'U', 'C', 0, 2, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zherk( 'L', 'N', 2, 0, ralpha, a, 1, rbeta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zherk( 'L', 'C', 0, 2, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zherk( 'U', 'N', 2, 0, ralpha, a, 2, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zherk( 'U', 'C', 2, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zherk( 'L', 'N', 2, 0, ralpha, a, 2, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zherk( 'L', 'C', 2, 0, ralpha, a, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      GO TO 100
   70 infot = 1
      CALL zsyrk( '/', 'N', 0, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zsyrk( 'U', 'C', 0, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zsyrk( 'U', 'N', -1, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zsyrk( 'U', 'T', -1, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zsyrk( 'L', 'N', -1, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zsyrk( 'L', 'T', -1, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zsyrk( 'U', 'N', 0, -1, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zsyrk( 'U', 'T', 0, -1, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zsyrk( 'L', 'N', 0, -1, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zsyrk( 'L', 'T', 0, -1, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zsyrk( 'U', 'N', 2, 0, alpha, a, 1, beta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zsyrk( 'U', 'T', 0, 2, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zsyrk( 'L', 'N', 2, 0, alpha, a, 1, beta, c, 2 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 7
      CALL zsyrk( 'L', 'T', 0, 2, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zsyrk( 'U', 'N', 2, 0, alpha, a, 2, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zsyrk( 'U', 'T', 2, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zsyrk( 'L', 'N', 2, 0, alpha, a, 2, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 10
      CALL zsyrk( 'L', 'T', 2, 0, alpha, a, 1, beta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      GO TO 100
   80 infot = 1
      CALL zher2k( '/', 'N', 0, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 2
      CALL zher2k( 'U', 'T', 0, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zher2k( 'U', 'N', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zher2k( 'U', 'C', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zher2k( 'L', 'N', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 3
      CALL zher2k( 'L', 'C', -1, 0, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zher2k( 'U', 'N', 0, -1, alpha, a, 1, b, 1, rbeta, c, 1 )
      CALL chkxer( srnamt, infot, nout, lerr, ok )
      infot = 4
      CALL zher2k( 'U', 'c', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZHER2K( 'l', 'n', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZHER2K( 'l', 'c', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHER2K( 'u', 'n', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHER2K( 'u', 'c', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHER2K( 'l', 'n', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZHER2K( 'l', 'c', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHER2K( 'u', 'n', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHER2K( 'u', 'c', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHER2K( 'l', 'n', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZHER2K( 'l', 'c', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHER2K( 'u', 'n', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHER2K( 'u', 'c', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHER2K( 'l', 'n', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZHER2K( 'l', 'c', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      GO TO 100
   90 INFOT = 1
      CALL ZSYR2K( '/', 'n', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 2
      CALL ZSYR2K( 'u', 'c', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYR2K( 'u', 'n', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYR2K( 'u', 't', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYR2K( 'l', 'n', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 3
      CALL ZSYR2K( 'l', 't', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYR2K( 'u', 'n', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYR2K( 'u', 't', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYR2K( 'l', 'n', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 4
      CALL ZSYR2K( 'l', 't', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYR2K( 'u', 'n', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYR2K( 'u', 't', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYR2K( 'l', 'n', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 7
      CALL ZSYR2K( 'l', 't', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYR2K( 'u', 'n', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYR2K( 'u', 't', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYR2K( 'l', 'n', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 9
      CALL ZSYR2K( 'l', 't', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYR2K( 'u', 'n', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYR2K( 'u', 't', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYR2K( 'l', 'n', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
      INFOT = 12
      CALL ZSYR2K( 'l', 't', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
      CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
*
  100 IF( OK )THEN
         WRITE( NOUT, FMT = 9999 )SRNAMT
      ELSE
         WRITE( NOUT, FMT = 9998 )SRNAMT
      END IF
      RETURN
*
 9999 FORMAT( ' ', A6, ' passed the tests of error-exits' )
 9998 FORMAT( ' ******* ', A6, ' failed the tests of error-exits *****',
     $      '**' )
*
*     End of ZCHKE
*

zmake()

subroutine zmake	(	character*2	type,
		character*1	uplo,
		character*1	diag,
		integer	m,
		integer	n,
		complex*16, dimension( nmax, * )	a,
		integer	nmax,
		complex*16, dimension( * )	aa,
		integer	lda,
		logical	reset,
		complex*16	transl )

Definition at line 2929 of file zblat3.f.

*
*  Generates values for an M by N matrix A.
*  Stores the values in the array AA in the data structure required
*  by the routine, with unwanted elements set to rogue value.
*
*  TYPE is 'GE', 'HE', 'SY' or 'TR'.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO, ONE
      parameter( zero = ( 0.0d0, 0.0d0 ),
     $                   one = ( 1.0d0, 0.0d0 ) )
      COMPLEX*16         ROGUE
      parameter( rogue = ( -1.0d10, 1.0d10 ) )
      DOUBLE PRECISION   RZERO
      parameter( rzero = 0.0d0 )
      DOUBLE PRECISION   RROGUE
      parameter( rrogue = -1.0d10 )
*     .. Scalar Arguments ..
      COMPLEX*16         TRANSL
      INTEGER            LDA, M, N, NMAX
      LOGICAL            RESET
      CHARACTER*1        DIAG, UPLO
      CHARACTER*2        TYPE
*     .. Array Arguments ..
      COMPLEX*16         A( NMAX, * ), AA( * )
*     .. Local Scalars ..
      INTEGER            I, IBEG, IEND, J, JJ
      LOGICAL            GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
*     .. External Functions ..
      COMPLEX*16         ZBEG
      EXTERNAL           zbeg
*     .. Intrinsic Functions ..
      INTRINSIC          dcmplx, dconjg, dble
*     .. Executable Statements ..
      gen = type.EQ.'GE'
      her = type.EQ.'HE'
      sym = type.EQ.'SY'
      tri = type.EQ.'TR'
      upper = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'U'
      lower = ( her.OR.sym.OR.tri ).AND.uplo.EQ.'L'
      unit = tri.AND.diag.EQ.'U'
*
*     Generate data in array A.
*
      DO 20 j = 1, n
         DO 10 i = 1, m
            IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
     $          THEN
               a( i, j ) = zbeg( reset ) + transl
               IF( i.NE.j )THEN
*                 Set some elements to zero
                  IF( n.GT.3.AND.j.EQ.n/2 )
     $               a( i, j ) = zero
                  IF( her )THEN
                     a( j, i ) = dconjg( a( i, j ) )
                  ELSE IF( sym )THEN
                     a( j, i ) = a( i, j )
                  ELSE IF( tri )THEN
                     a( j, i ) = zero
                  END IF
               END IF
            END IF
   10    CONTINUE
         IF( her )
     $      a( j, j ) = dcmplx( dble( a( j, j ) ), rzero )
         IF( tri )
     $      a( j, j ) = a( j, j ) + one
         IF( unit )
     $      a( j, j ) = one
   20 CONTINUE
*
*     Store elements in array AS in data structure required by routine.
*
      IF( type.EQ.'GE' )THEN
         DO 50 j = 1, n
            DO 30 i = 1, m
               aa( i + ( j - 1 )*lda ) = a( i, j )
   30       CONTINUE
            DO 40 i = m + 1, lda
               aa( i + ( j - 1 )*lda ) = rogue
   40       CONTINUE
   50    CONTINUE
      ELSE IF( type.EQ.'HE'.OR.type.EQ.'SY'.OR.type.EQ.'TR' )THEN
         DO 90 j = 1, n
            IF( upper )THEN
               ibeg = 1
               IF( unit )THEN
                  iend = j - 1
               ELSE
                  iend = j
               END IF
            ELSE
               IF( unit )THEN
                  ibeg = j + 1
               ELSE
                  ibeg = j
               END IF
               iend = n
            END IF
            DO 60 i = 1, ibeg - 1
               aa( i + ( j - 1 )*lda ) = rogue
   60       CONTINUE
            DO 70 i = ibeg, iend
               aa( i + ( j - 1 )*lda ) = a( i, j )
   70       CONTINUE
            DO 80 i = iend + 1, lda
               aa( i + ( j - 1 )*lda ) = rogue
   80       CONTINUE
            IF( her )THEN
               jj = j + ( j - 1 )*lda
               aa( jj ) = dcmplx( dble( aa( jj ) ), rrogue )
            END IF
   90    CONTINUE
      END IF
      RETURN
*
*     End of ZMAKE
*

zmmch()

subroutine zmmch	(	character*1	transa,
		character*1	transb,
		integer	m,
		integer	n,
		integer	kk,
		complex*16	alpha,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		complex*16, dimension( ldb, * )	b,
		integer	ldb,
		complex*16	beta,
		complex*16, dimension( ldc, * )	c,
		integer	ldc,
		complex*16, dimension( * )	ct,
		double precision, dimension( * )	g,
		complex*16, dimension( ldcc, * )	cc,
		integer	ldcc,
		double precision	eps,
		double precision	err,
		logical	fatal,
		integer	nout,
		logical	mv )

Definition at line 3058 of file zblat3.f.

*
*  Checks the results of the computational tests.
*
*  Auxiliary routine for test program for Level 3 Blas.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*     .. Parameters ..
      COMPLEX*16         ZERO
      parameter( zero = ( 0.0d0, 0.0d0 ) )
      DOUBLE PRECISION   RZERO, RONE
      parameter( rzero = 0.0d0, rone = 1.0d0 )
*     .. Scalar Arguments ..
      COMPLEX*16         ALPHA, BETA
      DOUBLE PRECISION   EPS, ERR
      INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
      LOGICAL            FATAL, MV
      CHARACTER*1        TRANSA, TRANSB
*     .. Array Arguments ..
      COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * ),
     $                   CC( LDCC, * ), CT( * )
      DOUBLE PRECISION   G( * )
*     .. Local Scalars ..
      COMPLEX*16         CL
      DOUBLE PRECISION   ERRI
      INTEGER            I, J, K
      LOGICAL            CTRANA, CTRANB, TRANA, TRANB
*     .. Intrinsic Functions ..
      INTRINSIC          abs, dimag, dconjg, max, dble, sqrt
*     .. Statement Functions ..
      DOUBLE PRECISION   ABS1
*     .. Statement Function definitions ..
      abs1( cl ) = abs( dble( cl ) ) + abs( dimag( cl ) )
*     .. Executable Statements ..
      trana = transa.EQ.'T'.OR.transa.EQ.'C'
      tranb = transb.EQ.'T'.OR.transb.EQ.'C'
      ctrana = transa.EQ.'C'
      ctranb = transb.EQ.'C'
*
*     Compute expected result, one column at a time, in CT using data
*     in A, B and C.
*     Compute gauges in G.
*
      DO 220 j = 1, n
*
         DO 10 i = 1, m
            ct( i ) = zero
            g( i ) = rzero
   10    CONTINUE
         IF( .NOT.trana.AND..NOT.tranb )THEN
            DO 30 k = 1, kk
               DO 20 i = 1, m
                  ct( i ) = ct( i ) + a( i, k )*b( k, j )
                  g( i ) = g( i ) + abs1( a( i, k ) )*abs1( b( k, j ) )
   20          CONTINUE
   30       CONTINUE
         ELSE IF( trana.AND..NOT.tranb )THEN
            IF( ctrana )THEN
               DO 50 k = 1, kk
                  DO 40 i = 1, m
                     ct( i ) = ct( i ) + dconjg( a( k, i ) )*b( k, j )
                     g( i ) = g( i ) + abs1( a( k, i ) )*
     $                        abs1( b( k, j ) )
   40             CONTINUE
   50          CONTINUE
            ELSE
               DO 70 k = 1, kk
                  DO 60 i = 1, m
                     ct( i ) = ct( i ) + a( k, i )*b( k, j )
                     g( i ) = g( i ) + abs1( a( k, i ) )*
     $                        abs1( b( k, j ) )
   60             CONTINUE
   70          CONTINUE
            END IF
         ELSE IF( .NOT.trana.AND.tranb )THEN
            IF( ctranb )THEN
               DO 90 k = 1, kk
                  DO 80 i = 1, m
                     ct( i ) = ct( i ) + a( i, k )*dconjg( b( j, k ) )
                     g( i ) = g( i ) + abs1( a( i, k ) )*
     $                        abs1( b( j, k ) )
   80             CONTINUE
   90          CONTINUE
            ELSE
               DO 110 k = 1, kk
                  DO 100 i = 1, m
                     ct( i ) = ct( i ) + a( i, k )*b( j, k )
                     g( i ) = g( i ) + abs1( a( i, k ) )*
     $                        abs1( b( j, k ) )
  100             CONTINUE
  110          CONTINUE
            END IF
         ELSE IF( trana.AND.tranb )THEN
            IF( ctrana )THEN
               IF( ctranb )THEN
                  DO 130 k = 1, kk
                     DO 120 i = 1, m
                        ct( i ) = ct( i ) + dconjg( a( k, i ) )*
     $                            dconjg( b( j, k ) )
                        g( i ) = g( i ) + abs1( a( k, i ) )*
     $                           abs1( b( j, k ) )
  120                CONTINUE
  130             CONTINUE
               ELSE
                  DO 150 k = 1, kk
                     DO 140 i = 1, m
                        ct( i ) = ct( i ) + dconjg( a( k, i ) )*
     $                            b( j, k )
                        g( i ) = g( i ) + abs1( a( k, i ) )*
     $                           abs1( b( j, k ) )
  140                CONTINUE
  150             CONTINUE
               END IF
            ELSE
               IF( ctranb )THEN
                  DO 170 k = 1, kk
                     DO 160 i = 1, m
                        ct( i ) = ct( i ) + a( k, i )*
     $                            dconjg( b( j, k ) )
                        g( i ) = g( i ) + abs1( a( k, i ) )*
     $                           abs1( b( j, k ) )
  160                CONTINUE
  170             CONTINUE
               ELSE
                  DO 190 k = 1, kk
                     DO 180 i = 1, m
                        ct( i ) = ct( i ) + a( k, i )*b( j, k )
                        g( i ) = g( i ) + abs1( a( k, i ) )*
     $                           abs1( b( j, k ) )
  180                CONTINUE
  190             CONTINUE
               END IF
            END IF
         END IF
         DO 200 i = 1, m
            ct( i ) = alpha*ct( i ) + beta*c( i, j )
            g( i ) = abs1( alpha )*g( i ) +
     $               abs1( beta )*abs1( c( i, j ) )
  200    CONTINUE
*
*        Compute the error ratio for this result.
*
         err = zero
         DO 210 i = 1, m
            erri = abs1( ct( i ) - cc( i, j ) )/eps
            IF( g( i ).NE.rzero )
     $         erri = erri/g( i )
            err = max( err, erri )
            IF( err*sqrt( eps ).GE.rone )
     $         GO TO 230
  210    CONTINUE
*
  220 CONTINUE
*
*     If the loop completes, all results are at least half accurate.
      GO TO 250
*
*     Report fatal error.
*
  230 fatal = .true.
      WRITE( nout, fmt = 9999 )
      DO 240 i = 1, m
         IF( mv )THEN
            WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
         ELSE
            WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
         END IF
  240 CONTINUE
      IF( n.GT.1 )
     $   WRITE( nout, fmt = 9997 )j
*
  250 CONTINUE
      RETURN
*
 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
     $      'F ACCURATE *******', /'                       EXPECTED RE',
     $      'SULT                    COMPUTED RESULT' )
 9998 FORMAT( 1x, i7, 2( '  (', g15.6, ',', g15.6, ')' ) )
 9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', i3 )
*
*     End of ZMMCH
*