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