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