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