cmmch()

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

Definition at line 2449 of file c_cblat3.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            ZERO
      parameter( zero = ( 0.0, 0.0 ) )
      REAL               RZERO, RONE
      parameter( rzero = 0.0, rone = 1.0 )
*     .. Scalar Arguments ..
      COMPLEX            ALPHA, BETA
      REAL               EPS, ERR
      INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
      LOGICAL            FATAL, MV
      CHARACTER*1        TRANSA, TRANSB
*     .. Array Arguments ..
      COMPLEX            A( LDA, * ), B( LDB, * ), C( LDC, * ),
     $                   CC( LDCC, * ), CT( * )
      REAL               G( * )
*     .. Local Scalars ..
      COMPLEX            CL
      REAL               ERRI
      INTEGER            I, J, K
      LOGICAL            CTRANA, CTRANB, TRANA, TRANB
*     .. Intrinsic Functions ..
      INTRINSIC          abs, aimag, conjg, max, real, sqrt
*     .. Statement Functions ..
      REAL               ABS1
*     .. Statement Function definitions ..
      abs1( cl ) = abs( real( cl ) ) + abs( aimag( 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 ) + conjg( 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 )*conjg( 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 ) + conjg( a( k, i ) )*
     $                            conjg( 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 ) + conjg( 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 )*conjg( 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 CMMCH.
*