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