test/zblat3.f

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