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