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