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