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