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