LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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 3050 of file cblat3.f.

3053*
3054* Checks the results of the computational tests.
3055*
3056* Auxiliary routine for test program for Level 3 Blas.
3057*
3058* -- Written on 8-February-1989.
3059* Jack Dongarra, Argonne National Laboratory.
3060* Iain Duff, AERE Harwell.
3061* Jeremy Du Croz, Numerical Algorithms Group Ltd.
3062* Sven Hammarling, Numerical Algorithms Group Ltd.
3063*
3064* .. Parameters ..
3065 COMPLEX ZERO
3066 parameter( zero = ( 0.0, 0.0 ) )
3067 REAL RZERO, RONE
3068 parameter( rzero = 0.0, rone = 1.0 )
3069* .. Scalar Arguments ..
3070 COMPLEX ALPHA, BETA
3071 REAL EPS, ERR
3072 INTEGER KK, LDA, LDB, LDC, LDCC, M, N, NOUT
3073 LOGICAL FATAL, MV
3074 CHARACTER*1 TRANSA, TRANSB
3075* .. Array Arguments ..
3076 COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ),
3077 $ CC( LDCC, * ), CT( * )
3078 REAL G( * )
3079* .. Local Scalars ..
3080 COMPLEX CL
3081 REAL ERRI
3082 INTEGER I, J, K
3083 LOGICAL CTRANA, CTRANB, TRANA, TRANB
3084* .. Intrinsic Functions ..
3085 INTRINSIC abs, aimag, conjg, max, real, sqrt
3086* .. Statement Functions ..
3087 REAL ABS1
3088* .. Statement Function definitions ..
3089 abs1( cl ) = abs( real( cl ) ) + abs( aimag( cl ) )
3090* .. Executable Statements ..
3091 trana = transa.EQ.'T'.OR.transa.EQ.'C'
3092 tranb = transb.EQ.'T'.OR.transb.EQ.'C'
3093 ctrana = transa.EQ.'C'
3094 ctranb = transb.EQ.'C'
3095*
3096* Compute expected result, one column at a time, in CT using data
3097* in A, B and C.
3098* Compute gauges in G.
3099*
3100 DO 220 j = 1, n
3101*
3102 DO 10 i = 1, m
3103 ct( i ) = zero
3104 g( i ) = rzero
3105 10 CONTINUE
3106 IF( .NOT.trana.AND..NOT.tranb )THEN
3107 DO 30 k = 1, kk
3108 DO 20 i = 1, m
3109 ct( i ) = ct( i ) + a( i, k )*b( k, j )
3110 g( i ) = g( i ) + abs1( a( i, k ) )*abs1( b( k, j ) )
3111 20 CONTINUE
3112 30 CONTINUE
3113 ELSE IF( trana.AND..NOT.tranb )THEN
3114 IF( ctrana )THEN
3115 DO 50 k = 1, kk
3116 DO 40 i = 1, m
3117 ct( i ) = ct( i ) + conjg( a( k, i ) )*b( k, j )
3118 g( i ) = g( i ) + abs1( a( k, i ) )*
3119 $ abs1( b( k, j ) )
3120 40 CONTINUE
3121 50 CONTINUE
3122 ELSE
3123 DO 70 k = 1, kk
3124 DO 60 i = 1, m
3125 ct( i ) = ct( i ) + a( k, i )*b( k, j )
3126 g( i ) = g( i ) + abs1( a( k, i ) )*
3127 $ abs1( b( k, j ) )
3128 60 CONTINUE
3129 70 CONTINUE
3130 END IF
3131 ELSE IF( .NOT.trana.AND.tranb )THEN
3132 IF( ctranb )THEN
3133 DO 90 k = 1, kk
3134 DO 80 i = 1, m
3135 ct( i ) = ct( i ) + a( i, k )*conjg( b( j, k ) )
3136 g( i ) = g( i ) + abs1( a( i, k ) )*
3137 $ abs1( b( j, k ) )
3138 80 CONTINUE
3139 90 CONTINUE
3140 ELSE
3141 DO 110 k = 1, kk
3142 DO 100 i = 1, m
3143 ct( i ) = ct( i ) + a( i, k )*b( j, k )
3144 g( i ) = g( i ) + abs1( a( i, k ) )*
3145 $ abs1( b( j, k ) )
3146 100 CONTINUE
3147 110 CONTINUE
3148 END IF
3149 ELSE IF( trana.AND.tranb )THEN
3150 IF( ctrana )THEN
3151 IF( ctranb )THEN
3152 DO 130 k = 1, kk
3153 DO 120 i = 1, m
3154 ct( i ) = ct( i ) + conjg( a( k, i ) )*
3155 $ conjg( b( j, k ) )
3156 g( i ) = g( i ) + abs1( a( k, i ) )*
3157 $ abs1( b( j, k ) )
3158 120 CONTINUE
3159 130 CONTINUE
3160 ELSE
3161 DO 150 k = 1, kk
3162 DO 140 i = 1, m
3163 ct( i ) = ct( i ) + conjg( a( k, i ) )*b( j, k )
3164 g( i ) = g( i ) + abs1( a( k, i ) )*
3165 $ abs1( b( j, k ) )
3166 140 CONTINUE
3167 150 CONTINUE
3168 END IF
3169 ELSE
3170 IF( ctranb )THEN
3171 DO 170 k = 1, kk
3172 DO 160 i = 1, m
3173 ct( i ) = ct( i ) + a( k, i )*conjg( b( j, k ) )
3174 g( i ) = g( i ) + abs1( a( k, i ) )*
3175 $ abs1( b( j, k ) )
3176 160 CONTINUE
3177 170 CONTINUE
3178 ELSE
3179 DO 190 k = 1, kk
3180 DO 180 i = 1, m
3181 ct( i ) = ct( i ) + a( k, i )*b( j, k )
3182 g( i ) = g( i ) + abs1( a( k, i ) )*
3183 $ abs1( b( j, k ) )
3184 180 CONTINUE
3185 190 CONTINUE
3186 END IF
3187 END IF
3188 END IF
3189 DO 200 i = 1, m
3190 ct( i ) = alpha*ct( i ) + beta*c( i, j )
3191 g( i ) = abs1( alpha )*g( i ) +
3192 $ abs1( beta )*abs1( c( i, j ) )
3193 200 CONTINUE
3194*
3195* Compute the error ratio for this result.
3196*
3197 err = zero
3198 DO 210 i = 1, m
3199 erri = abs1( ct( i ) - cc( i, j ) )/eps
3200 IF( g( i ).NE.rzero )
3201 $ erri = erri/g( i )
3202 err = max( err, erri )
3203 IF( err*sqrt( eps ).GE.rone )
3204 $ GO TO 230
3205 210 CONTINUE
3206*
3207 220 CONTINUE
3208*
3209* If the loop completes, all results are at least half accurate.
3210 GO TO 250
3211*
3212* Report fatal error.
3213*
3214 230 fatal = .true.
3215 WRITE( nout, fmt = 9999 )
3216 DO 240 i = 1, m
3217 IF( mv )THEN
3218 WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
3219 ELSE
3220 WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
3221 END IF
3222 240 CONTINUE
3223 IF( n.GT.1 )
3224 $ WRITE( nout, fmt = 9997 )j
3225*
3226 250 CONTINUE
3227 RETURN
3228*
3229 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
3230 $ 'F ACCURATE *******', /' EXPECTED RE',
3231 $ 'SULT COMPUTED RESULT' )
3232 9998 FORMAT( 1x, i7, 2( ' (', g15.6, ',', g15.6, ')' ) )
3233 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', i3 )
3234*
3235* End of CMMCH
3236*
Here is the caller graph for this function: