181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PROGRAM DBLAT3 281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test program for the DOUBLE PRECISION Level 3 Blas. 481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* The program must be driven by a short data file. The first 13 records 681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* of the file are read using list-directed input, the last 6 records 781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* are read using the format ( A12, L2 ). An annotated example of a data 881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* file can be obtained by deleting the first 3 characters from the 981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* following 19 lines: 1081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE 1181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0) 1281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD. 1381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* F LOGICAL FLAG, T TO STOP ON FAILURES. 1481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* T LOGICAL FLAG, T TO TEST ERROR EXITS. 1581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 2 0 TO TEST COLUMN-MAJOR, 1 TO TEST ROW-MAJOR, 2 TO TEST BOTH 1681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 16.0 THRESHOLD VALUE OF TEST RATIO 1781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 6 NUMBER OF VALUES OF N 1881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 0 1 2 3 5 9 VALUES OF N 1981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3 NUMBER OF VALUES OF ALPHA 2081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 0.0 1.0 0.7 VALUES OF ALPHA 2181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3 NUMBER OF VALUES OF BETA 2281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 0.0 1.0 1.3 VALUES OF BETA 2381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. 2481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. 2581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. 2681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. 2781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. 2881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. 2981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* See: 3181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S. 3381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* A Set of Level 3 Basic Linear Algebra Subprograms. 3481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Technical Memorandum No.88 (Revision 1), Mathematics and 3681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Computer Science Division, Argonne National Laboratory, 9700 3781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* South Cass Avenue, Argonne, Illinois 60439, US. 3881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 3981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 4081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 4181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 4281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 4381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 4481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 4581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 4681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NIN, NOUT 4781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( NIN = 5, NOUT = 6 ) 4881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NSUBS 4981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( NSUBS = 6 ) 5081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO, HALF, ONE 5181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) 5281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NMAX 5381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( NMAX = 65 ) 5481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NIDMAX, NALMAX, NBEMAX 5581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 ) 5681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 5781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION EPS, ERR, THRESH 5881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NTRA, 5981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LAYOUT 6081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, 6181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ TSTERR, CORDER, RORDER 6281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 TRANSA, TRANSB 6381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAMET 6481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*32 SNAPS 6581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 6681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), 6781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALF( NALMAX ), AS( NMAX*NMAX ), 6881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB( NMAX*NMAX ), BET( NBEMAX ), 6981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BS( NMAX*NMAX ), C( NMAX, NMAX ), 7081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ), 7181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ G( NMAX ), W( 2*NMAX ) 7281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDIM( NIDMAX ) 7381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LTEST( NSUBS ) 7481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAMES( NSUBS ) 7581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 7681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DDIFF 7781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LDE 7881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DDIFF, LDE 7981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 8081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, CD3CHKE, 8181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ DMMCH 8281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 8381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX, MIN 8481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 8581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INFOT, NOUTC 8681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL OK 8781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SRNAMT 8881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 8981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /INFOC/INFOT, NOUTC, OK 9081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /SRNAMC/SRNAMT 9181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 9281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ', 9381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'cblas_dtrmm ', 'cblas_dtrsm ','cblas_dsyrk ', 9481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'cblas_dsyr2k'/ 9581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 9681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 9781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read name and unit number for summary output file and open file. 9881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 9981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NOUTC = NOUT 10081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read name and unit number for snapshot output file and open file. 10181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 10281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )SNAPS 10381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )NTRA 10481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRACE = NTRA.GE.0 10581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE )THEN 10681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) 10781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 10881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read the flag that directs rewinding of the snapshot file. 10981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )REWI 11081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray REWI = REWI.AND.TRACE 11181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read the flag that directs stopping on any failure. 11281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )SFATAL 11381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read the flag that indicates whether error exits are to be tested. 11481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )TSTERR 11581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read the flag that indicates whether row-major data layout to be tested. 11681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )LAYOUT 11781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read the threshold value of the test ratio 11881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )THRESH 11981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 12081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read and check the parameter values for the tests. 12181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 12281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Values of N 12381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )NIDIM 12481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN 12581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9997 )'N', NIDMAX 12681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 220 12781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 12881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM ) 12981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, NIDIM 13081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN 13181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9996 )NMAX 13281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 220 13381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 13481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 13581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Values of ALPHA 13681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )NALF 13781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN 13881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX 13981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 220 14081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 14181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )( ALF( I ), I = 1, NALF ) 14281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Values of BETA 14381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )NBET 14481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN 14581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX 14681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 220 14781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 14881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray READ( NIN, FMT = * )( BET( I ), I = 1, NBET ) 14981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 15081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report values of parameters. 15181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 15281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9995 ) 15381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM ) 15481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF ) 15581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET ) 15681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.TSTERR )THEN 15781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = * ) 15881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9984 ) 15981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 16081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = * ) 16181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9999 )THRESH 16281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = * ) 16381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 16481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RORDER = .FALSE. 16581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CORDER = .FALSE. 16681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (LAYOUT.EQ.2) THEN 16781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RORDER = .TRUE. 16881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CORDER = .TRUE. 16981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( *, FMT = 10002 ) 17081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (LAYOUT.EQ.1) THEN 17181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RORDER = .TRUE. 17281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( *, FMT = 10001 ) 17381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (LAYOUT.EQ.0) THEN 17481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CORDER = .TRUE. 17581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( *, FMT = 10000 ) 17681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 17781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( *, FMT = * ) 17881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 17981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 18081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Read names of subroutines and flags which indicate 18181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* whether they are to be tested. 18281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 18381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, NSUBS 18481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LTEST( I ) = .FALSE. 18581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 18681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT 18781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, NSUBS 18881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( SNAMET.EQ.SNAMES( I ) ) 18981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 50 19081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 19181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9990 )SNAMET 19281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 19381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 LTEST( I ) = LTESTT 19481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 30 19581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 19681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 19781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CLOSE ( NIN ) 19881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 19981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Compute EPS (the machine precision). 20081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 20181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EPS = ONE 20281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 20381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( DDIFF( ONE + EPS, ONE ).EQ.ZERO ) 20481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 80 20581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EPS = HALF*EPS 20681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 70 20781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 20881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EPS = EPS + EPS 20981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9998 )EPS 21081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 21181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check the reliability of DMMCH using exact data. 21281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 21381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = MIN( 32, NMAX ) 21481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 J = 1, N 21581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 I = 1, N 21681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AB( I, J ) = MAX( I - J + 1, 0 ) 21781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 21881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AB( J, NMAX + 1 ) = J 21981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AB( 1, NMAX + J ) = J 22081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray C( J, 1 ) = ZERO 22181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 22281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 110 J = 1, N 22381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3 22481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 22581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* CC holds the exact result. On exit from DMMCH CT holds 22681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* the result computed by DMMCH. 22781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSA = 'N' 22881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSB = 'N' 22981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX, 23081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC, 23181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. ) 23281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = LDE( CC, CT, N ) 23381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN 23481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR 23581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 23681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 23781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSB = 'T' 23881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX, 23981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC, 24081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. ) 24181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = LDE( CC, CT, N ) 24281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN 24381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR 24481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 24581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 24681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 120 J = 1, N 24781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AB( J, NMAX + 1 ) = N - J + 1 24881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AB( 1, NMAX + J ) = N - J + 1 24981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 25081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 130 J = 1, N 25181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 - 25281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ( ( J + 1 )*J*( J - 1 ) )/3 25381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 130 CONTINUE 25481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSA = 'T' 25581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSB = 'N' 25681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX, 25781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC, 25881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. ) 25981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = LDE( CC, CT, N ) 26081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN 26181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR 26281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 26381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 26481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSB = 'T' 26581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX, 26681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC, 26781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, EPS, ERR, FATAL, NOUT, .TRUE. ) 26881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = LDE( CC, CT, N ) 26981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN 27081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR 27181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 27281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 27381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 27481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test each subroutine in turn. 27581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 27681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 200 ISNUM = 1, NSUBS 27781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = * ) 27881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.LTEST( ISNUM ) )THEN 27981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Subprogram is not to be tested. 28081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM ) 28181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 28281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SRNAMT = SNAMES( ISNUM ) 28381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test error exits. 28481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TSTERR )THEN 28581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CD3CHKE( SNAMES( ISNUM ) ) 28681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = * ) 28781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 28881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test computations. 28981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INFOT = 0 29081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray OK = .TRUE. 29181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .FALSE. 29281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM 29381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test DGEMM, 01. 29481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 140 IF (CORDER) THEN 29581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 29681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 29781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, 29881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, CS, CT, G, 0 ) 29981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 30081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (RORDER) THEN 30181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 30281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 30381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, 30481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, CS, CT, G, 1 ) 30581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 30681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 190 30781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test DSYMM, 02. 30881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 150 IF (CORDER) THEN 30981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 31081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 31181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, 31281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, CS, CT, G, 0 ) 31381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 31481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (RORDER) THEN 31581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 31681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 31781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, 31881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, CS, CT, G, 1 ) 31981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 32081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 190 32181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test DTRMM, 03, DTRSM, 04. 32281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 160 IF (CORDER) THEN 32381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 32481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, 32581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, 32681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 0 ) 32781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 32881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (RORDER) THEN 32981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 33081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, 33181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, 33281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 1 ) 33381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 33481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 190 33581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test DSYRK, 05. 33681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 170 IF (CORDER) THEN 33781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 33881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 33981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, 34081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, CS, CT, G, 0 ) 34181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 34281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (RORDER) THEN 34381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 34481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 34581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, 34681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, CS, CT, G, 1 ) 34781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 34881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 190 34981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Test DSYR2K, 06. 35081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 180 IF (CORDER) THEN 35181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 35281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 35381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, 35481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 0 ) 35581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 35681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (RORDER) THEN 35781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, 35881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, 35981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, 36081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 1 ) 36181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 36281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 190 36381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 36481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 190 IF( FATAL.AND.SFATAL ) 36581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 210 36681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 36781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 200 CONTINUE 36881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9986 ) 36981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 230 37081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 37181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 210 CONTINUE 37281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9985 ) 37381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 230 37481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 37581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 220 CONTINUE 37681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9991 ) 37781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 37881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 230 CONTINUE 37981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 38081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CLOSE ( NTRA ) 38181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CLOSE ( NOUT ) 38281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray STOP 38381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 38481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10002 FORMAT( ' COLUMN-MAJOR AND ROW-MAJOR DATA LAYOUTS ARE TESTED' ) 38581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10001 FORMAT( ' ROW-MAJOR DATA LAYOUT IS TESTED' ) 38681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10000 FORMAT( ' COLUMN-MAJOR DATA LAYOUT IS TESTED' ) 38781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES', 38881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'S THAN', F8.2 ) 38981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 ) 39081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ', 39181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'THAN ', I2 ) 39281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 ) 39381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( ' TESTS OF THE DOUBLE PRECISION LEVEL 3 BLAS', //' THE F', 39481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'OLLOWING PARAMETER VALUES WILL BE USED:' ) 39581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( ' FOR N ', 9I6 ) 39681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9993 FORMAT( ' FOR ALPHA ', 7F6.1 ) 39781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 39881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', 39981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ /' ******* TESTS ABANDONED *******' ) 40081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', 40181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ESTS ABANDONED *******' ) 40281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9989 FORMAT( ' ERROR IN DMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', 40381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1, 40481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ', 40581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', 40681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', 40781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ '*******' ) 40881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9988 FORMAT( A12,L2 ) 40981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) 41081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9986 FORMAT( /' END OF TESTS' ) 41181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 41281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) 41381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 41481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DBLAT3. 41581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 41681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 41781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 41881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, 41981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, IORDER) 42081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 42181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests DGEMM. 42281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 42381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 42481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 42581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 42681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 42781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 42881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 42981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 43081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 43181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 43281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO 43381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0 ) 43481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 43581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION EPS, THRESH 43681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER 43781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, REWI, TRACE 43881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 43981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 44081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), 44181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AS( NMAX*NMAX ), B( NMAX, NMAX ), 44281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), 44381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( NMAX, NMAX ), CC( NMAX*NMAX ), 44481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) 44581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDIM( NIDIM ) 44681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 44781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX 44881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, 44981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, 45081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ MA, MB, MS, N, NA, NARGS, NB, NC, NS 45181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL NULL, RESET, SAME, TRANA, TRANB 45281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB 45381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*3 ICH 45481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 45581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL ISAME( 13 ) 45681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 45781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LDE, LDERES 45881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL LDE, LDERES 45981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 46081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL CDGEMM, DMAKE, DMMCH 46181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 46281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX 46381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 46481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INFOT, NOUTC 46581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL OK 46681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 46781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /INFOC/INFOT, NOUTC, OK 46881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 46981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA ICH/'NTC'/ 47081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 47181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 47281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NARGS = 13 47381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = 0 47481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RESET = .TRUE. 47581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = ZERO 47681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 47781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 110 IM = 1, NIDIM 47881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray M = IDIM( IM ) 47981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 48081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 IN = 1, NIDIM 48181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = IDIM( IN ) 48281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDC to 1 more than minimum value if room. 48381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDC = M 48481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.LT.NMAX ) 48581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC = LDC + 1 48681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 48781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.GT.NMAX ) 48881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 100 48981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LCC = LDC*N 49081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NULL = N.LE.0.OR.M.LE.0 49181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 49281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 IK = 1, NIDIM 49381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray K = IDIM( IK ) 49481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 49581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 ICA = 1, 3 49681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSA = ICH( ICA: ICA ) 49781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' 49881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 49981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRANA )THEN 50081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MA = K 50181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = M 50281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 50381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MA = M 50481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = K 50581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 50681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDA to 1 more than minimum value if room. 50781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDA = MA 50881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.LT.NMAX ) 50981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA = LDA + 1 51081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 51181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.GT.NMAX ) 51281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 80 51381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LAA = LDA*NA 51481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 51581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix A. 51681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 51781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, 51881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ RESET, ZERO ) 51981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 52081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 ICB = 1, 3 52181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSB = ICH( ICB: ICB ) 52281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' 52381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 52481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRANB )THEN 52581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MB = N 52681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NB = K 52781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 52881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MB = K 52981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NB = N 53081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 53181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDB to 1 more than minimum value if room. 53281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDB = MB 53381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDB.LT.NMAX ) 53481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB = LDB + 1 53581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 53681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDB.GT.NMAX ) 53781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 70 53881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LBB = LDB*NB 53981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 54081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix B. 54181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 54281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, 54381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB, RESET, ZERO ) 54481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 54581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 IA = 1, NALF 54681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALPHA = ALF( IA ) 54781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 54881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 IB = 1, NBET 54981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BETA = BET( IB ) 55081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 55181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix C. 55281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 55381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', M, N, C, NMAX, 55481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, LDC, RESET, ZERO ) 55581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 55681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = NC + 1 55781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 55881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Save every datum before calling the 55981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* subroutine. 56081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 56181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANAS = TRANSA 56281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANBS = TRANSB 56381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MS = M 56481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NS = N 56581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray KS = K 56681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALS = ALPHA 56781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, LAA 56881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AS( I ) = AA( I ) 56981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 57081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDAS = LDA 57181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, LBB 57281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BS( I ) = BB( I ) 57381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 57481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDBS = LDB 57581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BLS = BETA 57681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, LCC 57781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS( I ) = CC( I ) 57881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 57981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDCS = LDC 58081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 58181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Call the subroutine. 58281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 58381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 58481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CALL DPRCN1(NTRA, NC, SNAME, IORDER, 58581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ TRANSA, TRANSB, M, N, K, ALPHA, LDA, 58681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB, BETA, LDC) 58781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( REWI ) 58881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWIND NTRA 58981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CDGEMM( IORDER, TRANSA, TRANSB, M, N, 59081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ K, ALPHA, AA, LDA, BB, LDB, 59181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BETA, CC, LDC ) 59281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 59381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check if error-exit was taken incorrectly. 59481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 59581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.OK )THEN 59681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9994 ) 59781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 59881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 120 59981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 60081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 60181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* See what data changed inside subroutines. 60281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 60381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 1 ) = TRANSA.EQ.TRANAS 60481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 2 ) = TRANSB.EQ.TRANBS 60581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 3 ) = MS.EQ.M 60681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 4 ) = NS.EQ.N 60781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 5 ) = KS.EQ.K 60881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 6 ) = ALS.EQ.ALPHA 60981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 7 ) = LDE( AS, AA, LAA ) 61081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 8 ) = LDAS.EQ.LDA 61181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 9 ) = LDE( BS, BB, LBB ) 61281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 10 ) = LDBS.EQ.LDB 61381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 11 ) = BLS.EQ.BETA 61481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NULL )THEN 61581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 12 ) = LDE( CS, CC, LCC ) 61681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 61781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 12 ) = LDERES( 'GE', ' ', M, N, CS, 61881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, LDC ) 61981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 62081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 13 ) = LDCS.EQ.LDC 62181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 62281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If data was incorrectly changed, report 62381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* and return. 62481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 62581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = .TRUE. 62681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, NARGS 62781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = SAME.AND.ISAME( I ) 62881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.ISAME( I ) ) 62981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9998 )I 63081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 63181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME )THEN 63281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 63381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 120 63481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 63581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 63681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.NULL )THEN 63781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 63881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check the result. 63981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 64081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, TRANSB, M, N, K, 64181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, A, NMAX, B, NMAX, BETA, 64281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C, NMAX, CT, G, CC, LDC, EPS, 64381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ERR, FATAL, NOUT, .TRUE. ) 64481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = MAX( ERRMAX, ERR ) 64581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If got really bad answer, report and 64681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 64781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( FATAL ) 64881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 120 64981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 65081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 65181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 65281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 65381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 65481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 65581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 65681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 65781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 65881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 65981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 66081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 66181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 66281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 66381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 66481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 66581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report result. 66681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 66781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( ERRMAX.LT.THRESH )THEN 66881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC 66981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC 67081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 67181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX 67281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX 67381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 67481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 130 67581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 67681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 67781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9996 )SNAME 67881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, 67981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ M, N, K, ALPHA, LDA, LDB, BETA, LDC) 68081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 68181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 130 CONTINUE 68281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 68381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 68481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', 68581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 68681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 68781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', 68881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 68981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 69081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', 69181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 69281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', 69381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 69481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', 69581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ANGED INCORRECTLY *******' ) 69681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) 69781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', 69881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', 69981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'C,', I3, ').' ) 70081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', 70181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ '******' ) 70281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 70381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DCHK1. 70481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 70581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 70681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, 70781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ K, ALPHA, LDA, LDB, BETA, LDC) 70881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC 70981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, BETA 71081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 TRANSA, TRANSB 71181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 71281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*14 CRC, CTA,CTB 71381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 71481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (TRANSA.EQ.'N')THEN 71581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CTA = ' CblasNoTrans' 71681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (TRANSA.EQ.'T')THEN 71781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CTA = ' CblasTrans' 71881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 71981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CTA = 'CblasConjTrans' 72081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 72181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (TRANSB.EQ.'N')THEN 72281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CTB = ' CblasNoTrans' 72381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (TRANSB.EQ.'T')THEN 72481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CTB = ' CblasTrans' 72581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 72681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CTB = 'CblasConjTrans' 72781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 72881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (IORDER.EQ.1)THEN 72981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasRowMajor' 73081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 73181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasColMajor' 73281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 73381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB 73481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC 73581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 73681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') 73781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', 73881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', ', 'C,', I3, ').' ) 73981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 74081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 74181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 74281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, 74381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, IORDER) 74481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 74581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests DSYMM. 74681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 74781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 74881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 74981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 75081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 75181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 75281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 75381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 75481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 75581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 75681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO 75781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0 ) 75881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 75981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION EPS, THRESH 76081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER 76181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, REWI, TRACE 76281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 76381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 76481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), 76581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AS( NMAX*NMAX ), B( NMAX, NMAX ), 76681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), 76781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( NMAX, NMAX ), CC( NMAX*NMAX ), 76881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) 76981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDIM( NIDIM ) 77081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 77181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX 77281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC, 77381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA, 77481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NARGS, NC, NS 77581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LEFT, NULL, RESET, SAME 77681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 SIDE, SIDES, UPLO, UPLOS 77781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*2 ICHS, ICHU 77881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 77981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL ISAME( 13 ) 78081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 78181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LDE, LDERES 78281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL LDE, LDERES 78381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 78481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DMAKE, DMMCH, CDSYMM 78581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 78681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX 78781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 78881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INFOT, NOUTC 78981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL OK 79081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 79181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /INFOC/INFOT, NOUTC, OK 79281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 79381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA ICHS/'LR'/, ICHU/'UL'/ 79481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 79581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 79681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NARGS = 12 79781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = 0 79881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RESET = .TRUE. 79981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = ZERO 80081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 80181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 IM = 1, NIDIM 80281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray M = IDIM( IM ) 80381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 80481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 IN = 1, NIDIM 80581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = IDIM( IN ) 80681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDC to 1 more than minimum value if room. 80781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDC = M 80881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.LT.NMAX ) 80981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC = LDC + 1 81081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 81181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.GT.NMAX ) 81281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 90 81381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LCC = LDC*N 81481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NULL = N.LE.0.OR.M.LE.0 81581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 81681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDB to 1 more than minimum value if room. 81781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDB = M 81881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDB.LT.NMAX ) 81981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB = LDB + 1 82081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 82181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDB.GT.NMAX ) 82281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 90 82381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LBB = LDB*N 82481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 82581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix B. 82681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 82781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET, 82881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ZERO ) 82981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 83081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 ICS = 1, 2 83181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SIDE = ICHS( ICS: ICS ) 83281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LEFT = SIDE.EQ.'L' 83381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 83481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LEFT )THEN 83581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = M 83681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 83781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = N 83881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 83981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDA to 1 more than minimum value if room. 84081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDA = NA 84181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.LT.NMAX ) 84281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA = LDA + 1 84381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 84481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.GT.NMAX ) 84581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 80 84681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LAA = LDA*NA 84781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 84881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 ICU = 1, 2 84981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLO = ICHU( ICU: ICU ) 85081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 85181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the symmetric matrix A. 85281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 85381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'SY', UPLO, ' ', NA, NA, A, NMAX, AA, LDA, 85481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ RESET, ZERO ) 85581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 85681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 IA = 1, NALF 85781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALPHA = ALF( IA ) 85881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 85981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 IB = 1, NBET 86081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BETA = BET( IB ) 86181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 86281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix C. 86381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 86481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC, 86581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC, RESET, ZERO ) 86681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 86781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = NC + 1 86881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 86981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Save every datum before calling the 87081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* subroutine. 87181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 87281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SIDES = SIDE 87381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLOS = UPLO 87481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MS = M 87581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NS = N 87681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALS = ALPHA 87781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, LAA 87881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AS( I ) = AA( I ) 87981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 88081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDAS = LDA 88181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, LBB 88281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BS( I ) = BB( I ) 88381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 88481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDBS = LDB 88581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BLS = BETA 88681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, LCC 88781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS( I ) = CC( I ) 88881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 88981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDCS = LDC 89081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 89181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Call the subroutine. 89281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 89381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 89481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CALL DPRCN2(NTRA, NC, SNAME, IORDER, 89581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ SIDE, UPLO, M, N, ALPHA, LDA, LDB, 89681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BETA, LDC) 89781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( REWI ) 89881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWIND NTRA 89981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CDSYMM( IORDER, SIDE, UPLO, M, N, ALPHA, 90081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AA, LDA, BB, LDB, BETA, CC, LDC ) 90181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 90281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check if error-exit was taken incorrectly. 90381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 90481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.OK )THEN 90581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9994 ) 90681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 90781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 110 90881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 90981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 91081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* See what data changed inside subroutines. 91181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 91281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 1 ) = SIDES.EQ.SIDE 91381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 2 ) = UPLOS.EQ.UPLO 91481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 3 ) = MS.EQ.M 91581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 4 ) = NS.EQ.N 91681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 5 ) = ALS.EQ.ALPHA 91781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 6 ) = LDE( AS, AA, LAA ) 91881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 7 ) = LDAS.EQ.LDA 91981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 8 ) = LDE( BS, BB, LBB ) 92081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 9 ) = LDBS.EQ.LDB 92181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 10 ) = BLS.EQ.BETA 92281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NULL )THEN 92381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 11 ) = LDE( CS, CC, LCC ) 92481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 92581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 11 ) = LDERES( 'GE', ' ', M, N, CS, 92681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, LDC ) 92781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 92881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 12 ) = LDCS.EQ.LDC 92981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 93081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If data was incorrectly changed, report and 93181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 93281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 93381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = .TRUE. 93481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, NARGS 93581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = SAME.AND.ISAME( I ) 93681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.ISAME( I ) ) 93781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9998 )I 93881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 93981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME )THEN 94081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 94181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 110 94281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 94381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 94481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.NULL )THEN 94581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 94681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check the result. 94781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 94881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LEFT )THEN 94981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'N', 'N', M, N, M, ALPHA, A, 95081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, B, NMAX, BETA, C, NMAX, 95181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CT, G, CC, LDC, EPS, ERR, 95281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 95381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 95481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'N', 'N', M, N, N, ALPHA, B, 95581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, A, NMAX, BETA, C, NMAX, 95681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CT, G, CC, LDC, EPS, ERR, 95781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 95881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 95981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = MAX( ERRMAX, ERR ) 96081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If got really bad answer, report and 96181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 96281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( FATAL ) 96381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 110 96481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 96581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 96681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 96781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 96881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 96981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 97081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 97181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 97281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 97381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 97481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 97581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 97681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 97781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 97881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report result. 97981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 98081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( ERRMAX.LT.THRESH )THEN 98181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC 98281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC 98381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 98481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX 98581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX 98681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 98781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 120 98881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 98981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 99081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9996 )SNAME 99181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, ALPHA, LDA, 99281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB, BETA, LDC) 99381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 99481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 99581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 99681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 99781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', 99881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 99981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 100081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', 100181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 100281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 100381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', 100481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 100581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', 100681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 100781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', 100881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ANGED INCORRECTLY *******' ) 100981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) 101081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), 101181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', 101281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' .' ) 101381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', 101481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ '******' ) 101581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 101681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DCHK2. 101781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 101881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 101981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 102081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, 102181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, LDA, LDB, BETA, LDC) 102281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC 102381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, BETA 102481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 SIDE, UPLO 102581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 102681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*14 CRC, CS,CU 102781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 102881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (SIDE.EQ.'L')THEN 102981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS = ' CblasLeft' 103081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 103181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS = ' CblasRight' 103281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 103381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (UPLO.EQ.'U')THEN 103481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasUpper' 103581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 103681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasLower' 103781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 103881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (IORDER.EQ.1)THEN 103981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasRowMajor' 104081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 104181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasColMajor' 104281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 104381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU 104481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC 104581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 104681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') 104781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', 104881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', ', 'C,', I3, ').' ) 104981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 105081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 105181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 105281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS, 105381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ B, BB, BS, CT, G, C, IORDER ) 105481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 105581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests DTRMM and DTRSM. 105681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 105781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 105881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 105981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 106081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 106181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 106281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 106381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 106481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 106581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 106681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO, ONE 106781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 106881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 106981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION EPS, THRESH 107081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER 107181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, REWI, TRACE 107281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 107381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 107481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), 107581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AS( NMAX*NMAX ), B( NMAX, NMAX ), 107681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB( NMAX*NMAX ), BS( NMAX*NMAX ), 107781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( NMAX, NMAX ), CT( NMAX ), G( NMAX ) 107881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDIM( NIDIM ) 107981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 108081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, ALS, ERR, ERRMAX 108181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB, 108281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC, 108381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NS 108481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LEFT, NULL, RESET, SAME 108581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO, 108681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ UPLOS 108781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*2 ICHD, ICHS, ICHU 108881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*3 ICHT 108981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 109081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL ISAME( 13 ) 109181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 109281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LDE, LDERES 109381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL LDE, LDERES 109481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 109581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DMAKE, DMMCH, CDTRMM, CDTRSM 109681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 109781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX 109881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 109981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INFOT, NOUTC 110081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL OK 110181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 110281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /INFOC/INFOT, NOUTC, OK 110381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 110481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/ 110581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 110681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 110781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NARGS = 11 110881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = 0 110981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RESET = .TRUE. 111081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = ZERO 111181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set up zero matrix for DMMCH. 111281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 J = 1, NMAX 111381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, NMAX 111481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray C( I, J ) = ZERO 111581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 111681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 111781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 111881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 140 IM = 1, NIDIM 111981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray M = IDIM( IM ) 112081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 112181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 130 IN = 1, NIDIM 112281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = IDIM( IN ) 112381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDB to 1 more than minimum value if room. 112481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDB = M 112581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDB.LT.NMAX ) 112681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB = LDB + 1 112781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 112881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDB.GT.NMAX ) 112981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 130 113081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LBB = LDB*N 113181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NULL = M.LE.0.OR.N.LE.0 113281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 113381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 120 ICS = 1, 2 113481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SIDE = ICHS( ICS: ICS ) 113581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LEFT = SIDE.EQ.'L' 113681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LEFT )THEN 113781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = M 113881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 113981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = N 114081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 114181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDA to 1 more than minimum value if room. 114281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDA = NA 114381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.LT.NMAX ) 114481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA = LDA + 1 114581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 114681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.GT.NMAX ) 114781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 130 114881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LAA = LDA*NA 114981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 115081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 110 ICU = 1, 2 115181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLO = ICHU( ICU: ICU ) 115281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 115381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 ICT = 1, 3 115481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSA = ICHT( ICT: ICT ) 115581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 115681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 ICD = 1, 2 115781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DIAG = ICHD( ICD: ICD ) 115881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 115981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 IA = 1, NALF 116081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALPHA = ALF( IA ) 116181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 116281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix A. 116381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 116481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'TR', UPLO, DIAG, NA, NA, A, 116581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, AA, LDA, RESET, ZERO ) 116681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 116781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix B. 116881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 116981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', M, N, B, NMAX, 117081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB, RESET, ZERO ) 117181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 117281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = NC + 1 117381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 117481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Save every datum before calling the 117581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* subroutine. 117681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 117781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SIDES = SIDE 117881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLOS = UPLO 117981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANAS = TRANSA 118081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DIAGS = DIAG 118181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MS = M 118281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NS = N 118381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALS = ALPHA 118481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, LAA 118581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AS( I ) = AA( I ) 118681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 118781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDAS = LDA 118881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, LBB 118981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BS( I ) = BB( I ) 119081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 119181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDBS = LDB 119281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 119381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Call the subroutine. 119481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 119581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( SNAME( 10: 11 ).EQ.'mm' )THEN 119681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 119781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CALL DPRCN3( NTRA, NC, SNAME, IORDER, 119881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, 119981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, LDB) 120081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( REWI ) 120181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWIND NTRA 120281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CDTRMM( IORDER, SIDE, UPLO, TRANSA, 120381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ DIAG, M, N, ALPHA, AA, LDA, 120481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB ) 120581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( SNAME( 10: 11 ).EQ.'sm' )THEN 120681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 120781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CALL DPRCN3( NTRA, NC, SNAME, IORDER, 120881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, 120981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, LDB) 121081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( REWI ) 121181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWIND NTRA 121281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CDTRSM( IORDER, SIDE, UPLO, TRANSA, 121381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ DIAG, M, N, ALPHA, AA, LDA, 121481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB ) 121581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 121681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 121781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check if error-exit was taken incorrectly. 121881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 121981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.OK )THEN 122081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9994 ) 122181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 122281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 150 122381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 122481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 122581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* See what data changed inside subroutines. 122681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 122781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 1 ) = SIDES.EQ.SIDE 122881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 2 ) = UPLOS.EQ.UPLO 122981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 3 ) = TRANAS.EQ.TRANSA 123081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 4 ) = DIAGS.EQ.DIAG 123181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 5 ) = MS.EQ.M 123281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 6 ) = NS.EQ.N 123381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 7 ) = ALS.EQ.ALPHA 123481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 8 ) = LDE( AS, AA, LAA ) 123581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 9 ) = LDAS.EQ.LDA 123681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NULL )THEN 123781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 10 ) = LDE( BS, BB, LBB ) 123881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 123981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 10 ) = LDERES( 'GE', ' ', M, N, BS, 124081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB ) 124181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 124281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 11 ) = LDBS.EQ.LDB 124381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 124481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If data was incorrectly changed, report and 124581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 124681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 124781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = .TRUE. 124881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 I = 1, NARGS 124981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = SAME.AND.ISAME( I ) 125081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.ISAME( I ) ) 125181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9998 )I 125281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 125381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME )THEN 125481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 125581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 150 125681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 125781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 125881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.NULL )THEN 125981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( SNAME( 10: 11 ).EQ.'mm' )THEN 126081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 126181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check the result. 126281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 126381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LEFT )THEN 126481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, 'N', M, N, M, 126581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, A, NMAX, B, NMAX, 126681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ZERO, C, NMAX, CT, G, 126781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB, EPS, ERR, 126881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 126981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 127081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'N', TRANSA, M, N, N, 127181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, B, NMAX, A, NMAX, 127281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ZERO, C, NMAX, CT, G, 127381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB, EPS, ERR, 127481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 127581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 127681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( SNAME( 10: 11 ).EQ.'sm' )THEN 127781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 127881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Compute approximation to original 127981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* matrix. 128081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 128181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 J = 1, N 128281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 I = 1, M 128381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray C( I, J ) = BB( I + ( J - 1 )* 128481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDB ) 128581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BB( I + ( J - 1 )*LDB ) = ALPHA* 128681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ B( I, J ) 128781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 128881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 128981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 129081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LEFT )THEN 129181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( TRANSA, 'N', M, N, M, 129281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ONE, A, NMAX, C, NMAX, 129381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ZERO, B, NMAX, CT, G, 129481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB, EPS, ERR, 129581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .FALSE. ) 129681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 129781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'N', TRANSA, M, N, N, 129881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ONE, C, NMAX, A, NMAX, 129981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ZERO, B, NMAX, CT, G, 130081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB, LDB, EPS, ERR, 130181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .FALSE. ) 130281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 130381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 130481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = MAX( ERRMAX, ERR ) 130581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If got really bad answer, report and 130681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 130781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( FATAL ) 130881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 150 130981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 131081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 131181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 131281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 131381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 131481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 131581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 131681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 131781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 131881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 131981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 132081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 132181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 130 CONTINUE 132281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 132381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 140 CONTINUE 132481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 132581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report result. 132681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 132781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( ERRMAX.LT.THRESH )THEN 132881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC 132981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC 133081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 133181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX 133281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX 133381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 133481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 160 133581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 133681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 150 CONTINUE 133781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9996 )SNAME 133881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DPRCN3( NTRA, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, DIAG, 133981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ M, N, ALPHA, LDA, LDB) 134081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 134181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 160 CONTINUE 134281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 134381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 134481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', 134581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 134681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 134781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', 134881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 134981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 135081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', 135181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 135281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', 135381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 135481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', 135581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ANGED INCORRECTLY *******' ) 135681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) 135781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), 135881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ', B,', I3, ') .' ) 135981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', 136081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ '******' ) 136181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 136281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DCHK3. 136381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 136481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 136581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 136681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, 136781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ DIAG, M, N, ALPHA, LDA, LDB) 136881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT, NC, IORDER, M, N, LDA, LDB 136981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA 137081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 SIDE, UPLO, TRANSA, DIAG 137181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 137281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*14 CRC, CS, CU, CA, CD 137381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 137481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (SIDE.EQ.'L')THEN 137581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS = ' CblasLeft' 137681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 137781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS = ' CblasRight' 137881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 137981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (UPLO.EQ.'U')THEN 138081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasUpper' 138181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 138281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasLower' 138381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 138481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (TRANSA.EQ.'N')THEN 138581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = ' CblasNoTrans' 138681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (TRANSA.EQ.'T')THEN 138781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = ' CblasTrans' 138881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 138981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = 'CblasConjTrans' 139081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 139181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (DIAG.EQ.'N')THEN 139281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CD = ' CblasNonUnit' 139381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 139481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CD = ' CblasUnit' 139581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 139681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (IORDER.EQ.1)THEN 139781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasRowMajor' 139881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 139981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasColMajor' 140081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 140181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU 140281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB 140381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 140481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') 140581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ), 140681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ', B,', I3, ').' ) 140781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 140881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 140981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 141081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, 141181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, IORDER) 141281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 141381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests DSYRK. 141481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 141581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 141681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 141781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 141881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 141981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 142081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 142181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 142281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 142381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 142481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO 142581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0 ) 142681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 142781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION EPS, THRESH 142881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER 142981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, REWI, TRACE 143081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 143181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 143281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), 143381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AS( NMAX*NMAX ), B( NMAX, NMAX ), 143481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), 143581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( NMAX, NMAX ), CC( NMAX*NMAX ), 143681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) 143781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDIM( NIDIM ) 143881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 143981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX 144081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS, 144181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA, 144281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NARGS, NC, NS 144381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL NULL, RESET, SAME, TRAN, UPPER 144481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 TRANS, TRANSS, UPLO, UPLOS 144581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*2 ICHU 144681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*3 ICHT 144781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 144881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL ISAME( 13 ) 144981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 145081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LDE, LDERES 145181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL LDE, LDERES 145281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 145381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DMAKE, DMMCH, CDSYRK 145481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 145581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX 145681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 145781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INFOT, NOUTC 145881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL OK 145981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 146081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /INFOC/INFOT, NOUTC, OK 146181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 146281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA ICHT/'NTC'/, ICHU/'UL'/ 146381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 146481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 146581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NARGS = 10 146681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = 0 146781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RESET = .TRUE. 146881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = ZERO 146981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 147081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 IN = 1, NIDIM 147181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = IDIM( IN ) 147281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDC to 1 more than minimum value if room. 147381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDC = N 147481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.LT.NMAX ) 147581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC = LDC + 1 147681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 147781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.GT.NMAX ) 147881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 100 147981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LCC = LDC*N 148081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NULL = N.LE.0 148181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 148281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 IK = 1, NIDIM 148381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray K = IDIM( IK ) 148481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 148581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 ICT = 1, 3 148681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANS = ICHT( ICT: ICT ) 148781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C' 148881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN )THEN 148981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MA = K 149081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = N 149181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 149281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MA = N 149381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = K 149481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 149581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDA to 1 more than minimum value if room. 149681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDA = MA 149781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.LT.NMAX ) 149881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA = LDA + 1 149981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 150081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.GT.NMAX ) 150181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 80 150281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LAA = LDA*NA 150381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 150481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix A. 150581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 150681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, 150781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ RESET, ZERO ) 150881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 150981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 ICU = 1, 2 151081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLO = ICHU( ICU: ICU ) 151181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPPER = UPLO.EQ.'U' 151281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 151381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 IA = 1, NALF 151481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALPHA = ALF( IA ) 151581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 151681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 IB = 1, NBET 151781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BETA = BET( IB ) 151881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 151981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix C. 152081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 152181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC, 152281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC, RESET, ZERO ) 152381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 152481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = NC + 1 152581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 152681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Save every datum before calling the subroutine. 152781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 152881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLOS = UPLO 152981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSS = TRANS 153081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NS = N 153181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray KS = K 153281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALS = ALPHA 153381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, LAA 153481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AS( I ) = AA( I ) 153581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 153681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDAS = LDA 153781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BETS = BETA 153881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, LCC 153981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS( I ) = CC( I ) 154081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 154181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDCS = LDC 154281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 154381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Call the subroutine. 154481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 154581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 154681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CALL DPRCN4( NTRA, NC, SNAME, IORDER, UPLO, 154781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ TRANS, N, K, ALPHA, LDA, BETA, LDC) 154881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( REWI ) 154981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWIND NTRA 155081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CDSYRK( IORDER, UPLO, TRANS, N, K, ALPHA, 155181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AA, LDA, BETA, CC, LDC ) 155281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 155381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check if error-exit was taken incorrectly. 155481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 155581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.OK )THEN 155681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9993 ) 155781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 155881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 120 155981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 156081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 156181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* See what data changed inside subroutines. 156281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 156381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 1 ) = UPLOS.EQ.UPLO 156481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 2 ) = TRANSS.EQ.TRANS 156581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 3 ) = NS.EQ.N 156681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 4 ) = KS.EQ.K 156781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 5 ) = ALS.EQ.ALPHA 156881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 6 ) = LDE( AS, AA, LAA ) 156981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 7 ) = LDAS.EQ.LDA 157081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 8 ) = BETS.EQ.BETA 157181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NULL )THEN 157281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 9 ) = LDE( CS, CC, LCC ) 157381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 157481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 9 ) = LDERES( 'SY', UPLO, N, N, CS, 157581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, LDC ) 157681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 157781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 10 ) = LDCS.EQ.LDC 157881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 157981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If data was incorrectly changed, report and 158081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 158181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 158281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = .TRUE. 158381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, NARGS 158481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = SAME.AND.ISAME( I ) 158581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.ISAME( I ) ) 158681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9998 )I 158781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 158881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME )THEN 158981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 159081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 120 159181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 159281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 159381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.NULL )THEN 159481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 159581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check the result column by column. 159681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 159781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JC = 1 159881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 J = 1, N 159981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UPPER )THEN 160081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JJ = 1 160181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LJ = J 160281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 160381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JJ = J 160481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LJ = N - J + 1 160581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 160681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN )THEN 160781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'T', 'N', LJ, 1, K, ALPHA, 160881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( 1, JJ ), NMAX, 160981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( 1, J ), NMAX, BETA, 161081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( JJ, J ), NMAX, CT, G, 161181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC( JC ), LDC, EPS, ERR, 161281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 161381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 161481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'N', 'T', LJ, 1, K, ALPHA, 161581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( JJ, 1 ), NMAX, 161681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( J, 1 ), NMAX, BETA, 161781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( JJ, J ), NMAX, CT, G, 161881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC( JC ), LDC, EPS, ERR, 161981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 162081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 162181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UPPER )THEN 162281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JC = JC + LDC 162381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 162481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JC = JC + LDC + 1 162581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 162681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = MAX( ERRMAX, ERR ) 162781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If got really bad answer, report and 162881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 162981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( FATAL ) 163081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 110 163181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 163281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 163381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 163481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 163581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 163681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 163781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 163881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 163981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 164081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 164181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 164281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 164381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 164481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 164581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 164681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report result. 164781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 164881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( ERRMAX.LT.THRESH )THEN 164981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC 165081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC 165181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 165281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX 165381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX 165481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 165581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 130 165681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 165781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 165881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( N.GT.1 ) 165981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9995 )J 166081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 166181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 166281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9996 )SNAME 166381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DPRCN4( NOUT, NC, SNAME, IORDER, UPLO, TRANS, N, K, ALPHA, 166481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, BETA, LDC) 166581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 166681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 130 CONTINUE 166781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 166881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 166981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', 167081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 167181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 167281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', 167381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 167481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 167581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', 167681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 167781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', 167881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 167981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', 168081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ANGED INCORRECTLY *******' ) 168181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) 168281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) 168381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), 168481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) 168581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', 168681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ '******' ) 168781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 168881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DCHK4. 168981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 169081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 169181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 169281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, 169381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ N, K, ALPHA, LDA, BETA, LDC) 169481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT, NC, IORDER, N, K, LDA, LDC 169581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, BETA 169681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 UPLO, TRANSA 169781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 169881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*14 CRC, CU, CA 169981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 170081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (UPLO.EQ.'U')THEN 170181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasUpper' 170281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 170381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasLower' 170481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 170581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (TRANSA.EQ.'N')THEN 170681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = ' CblasNoTrans' 170781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (TRANSA.EQ.'T')THEN 170881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = ' CblasTrans' 170981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 171081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = 'CblasConjTrans' 171181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 171281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (IORDER.EQ.1)THEN 171381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasRowMajor' 171481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 171581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasColMajor' 171681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 171781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA 171881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC 171981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 172081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) 172181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 20X, 2( I3, ',' ), 172281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) 172381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 172481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 172581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 172681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, 172781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, 172881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ IORDER ) 172981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 173081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests DSYR2K. 173181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 173281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 173381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 173481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 173581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 173681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 173781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 173881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 173981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 174081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 174181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO 174281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0 ) 174381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 174481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION EPS, THRESH 174581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER 174681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, REWI, TRACE 174781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 174881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 174981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), 175081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), 175181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ), 175281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ), 175381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ G( NMAX ), W( 2*NMAX ) 175481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER IDIM( NIDIM ) 175581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 175681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, ALS, BETA, BETS, ERR, ERRMAX 175781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB, 175881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS, 175981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS 176081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL NULL, RESET, SAME, TRAN, UPPER 176181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 TRANS, TRANSS, UPLO, UPLOS 176281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*2 ICHU 176381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*3 ICHT 176481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Arrays .. 176581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL ISAME( 13 ) 176681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 176781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL LDE, LDERES 176881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL LDE, LDERES 176981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Subroutines .. 177081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DMAKE, DMMCH, CDSYR2K 177181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 177281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC MAX 177381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalars in Common .. 177481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER INFOT, NOUTC 177581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL OK 177681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Common blocks .. 177781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray COMMON /INFOC/INFOT, NOUTC, OK 177881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Data statements .. 177981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DATA ICHT/'NTC'/, ICHU/'UL'/ 178081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 178181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 178281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NARGS = 12 178381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = 0 178481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RESET = .TRUE. 178581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = ZERO 178681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 178781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 130 IN = 1, NIDIM 178881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray N = IDIM( IN ) 178981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDC to 1 more than minimum value if room. 179081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDC = N 179181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.LT.NMAX ) 179281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC = LDC + 1 179381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 179481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDC.GT.NMAX ) 179581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 130 179681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LCC = LDC*N 179781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NULL = N.LE.0 179881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 179981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 120 IK = 1, NIDIM 180081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray K = IDIM( IK ) 180181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 180281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 110 ICT = 1, 3 180381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANS = ICHT( ICT: ICT ) 180481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRAN = TRANS.EQ.'T'.OR.TRANS.EQ.'C' 180581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN )THEN 180681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MA = K 180781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = N 180881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 180981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MA = N 181081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NA = K 181181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 181281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set LDA to 1 more than minimum value if room. 181381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDA = MA 181481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.LT.NMAX ) 181581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA = LDA + 1 181681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Skip tests if not enough room. 181781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( LDA.GT.NMAX ) 181881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 110 181981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LAA = LDA*NA 182081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 182181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix A. 182281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 182381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN )THEN 182481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA, 182581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, RESET, ZERO ) 182681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 182781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA, 182881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ RESET, ZERO ) 182981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 183081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 183181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix B. 183281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 183381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDB = LDA 183481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LBB = LAA 183581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN )THEN 183681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ), 183781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 2*NMAX, BB, LDB, RESET, ZERO ) 183881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 183981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ), 184081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, BB, LDB, RESET, ZERO ) 184181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 184281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 184381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 ICU = 1, 2 184481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLO = ICHU( ICU: ICU ) 184581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPPER = UPLO.EQ.'U' 184681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 184781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 IA = 1, NALF 184881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALPHA = ALF( IA ) 184981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 185081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 IB = 1, NBET 185181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BETA = BET( IB ) 185281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 185381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate the matrix C. 185481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 185581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMAKE( 'SY', UPLO, ' ', N, N, C, NMAX, CC, 185681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDC, RESET, ZERO ) 185781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 185881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NC = NC + 1 185981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 186081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Save every datum before calling the subroutine. 186181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 186281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPLOS = UPLO 186381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANSS = TRANS 186481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray NS = N 186581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray KS = K 186681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ALS = ALPHA 186781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, LAA 186881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AS( I ) = AA( I ) 186981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 187081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDAS = LDA 187181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, LBB 187281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BS( I ) = BB( I ) 187381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 187481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDBS = LDB 187581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray BETS = BETA 187681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, LCC 187781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CS( I ) = CC( I ) 187881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 187981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDCS = LDC 188081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 188181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Call the subroutine. 188281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 188381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRACE ) 188481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CALL DPRCN5( NTRA, NC, SNAME, IORDER, UPLO, 188581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC) 188681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( REWI ) 188781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ REWIND NTRA 188881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL CDSYR2K( IORDER, UPLO, TRANS, N, K, 188981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, AA, LDA, BB, LDB, BETA, 189081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, LDC ) 189181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 189281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check if error-exit was taken incorrectly. 189381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 189481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.OK )THEN 189581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9993 ) 189681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 189781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 150 189881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 189981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 190081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* See what data changed inside subroutines. 190181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 190281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 1 ) = UPLOS.EQ.UPLO 190381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 2 ) = TRANSS.EQ.TRANS 190481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 3 ) = NS.EQ.N 190581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 4 ) = KS.EQ.K 190681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 5 ) = ALS.EQ.ALPHA 190781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 6 ) = LDE( AS, AA, LAA ) 190881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 7 ) = LDAS.EQ.LDA 190981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 8 ) = LDE( BS, BB, LBB ) 191081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 9 ) = LDBS.EQ.LDB 191181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 10 ) = BETS.EQ.BETA 191281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( NULL )THEN 191381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 11 ) = LDE( CS, CC, LCC ) 191481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 191581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 11 ) = LDERES( 'SY', UPLO, N, N, CS, 191681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC, LDC ) 191781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 191881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ISAME( 12 ) = LDCS.EQ.LDC 191981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 192081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If data was incorrectly changed, report and 192181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 192281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 192381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = .TRUE. 192481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, NARGS 192581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAME = SAME.AND.ISAME( I ) 192681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.ISAME( I ) ) 192781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9998 )I 192881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 192981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.SAME )THEN 193081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray FATAL = .TRUE. 193181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 150 193281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 193381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 193481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.NULL )THEN 193581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 193681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Check the result column by column. 193781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 193881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JJAB = 1 193981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JC = 1 194081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 J = 1, N 194181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UPPER )THEN 194281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JJ = 1 194381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LJ = J 194481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 194581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JJ = J 194681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LJ = N - J + 1 194781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 194881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN )THEN 194981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 I = 1, K 195081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray W( I ) = AB( ( J - 1 )*2*NMAX + K + 195181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ I ) 195281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray W( K + I ) = AB( ( J - 1 )*2*NMAX + 195381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ I ) 195481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 195581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'T', 'N', LJ, 1, 2*K, 195681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, AB( JJAB ), 2*NMAX, 195781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ W, 2*NMAX, BETA, 195881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ C( JJ, J ), NMAX, CT, G, 195981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC( JC ), LDC, EPS, ERR, 196081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ FATAL, NOUT, .TRUE. ) 196181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 196281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 I = 1, K 196381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray W( I ) = AB( ( K + I - 1 )*NMAX + 196481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ J ) 196581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray W( K + I ) = AB( ( I - 1 )*NMAX + 196681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ J ) 196781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 196881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DMMCH( 'N', 'N', LJ, 1, 2*K, 196981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ALPHA, AB( JJ ), NMAX, W, 197081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 2*NMAX, BETA, C( JJ, J ), 197181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NMAX, CT, G, CC( JC ), LDC, 197281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ EPS, ERR, FATAL, NOUT, 197381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ .TRUE. ) 197481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 197581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UPPER )THEN 197681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JC = JC + LDC 197781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 197881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray JC = JC + LDC + 1 197981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRAN ) 198081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ JJAB = JJAB + 2*NMAX 198181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 198281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRMAX = MAX( ERRMAX, ERR ) 198381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If got really bad answer, report and 198481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* return. 198581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( FATAL ) 198681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 140 198781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 198881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 198981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 199081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 199181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 199281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 199381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 199481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 199581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 199681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 199781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 199881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 199981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 200081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 130 CONTINUE 200181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 200281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report result. 200381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 200481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( ERRMAX.LT.THRESH )THEN 200581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC 200681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC 200781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 200881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX 200981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX 201081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 201181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 160 201281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 201381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 140 CONTINUE 201481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( N.GT.1 ) 201581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9995 )J 201681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 201781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 150 CONTINUE 201881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9996 )SNAME 201981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CALL DPRCN5( NOUT, NC, SNAME, IORDER, UPLO, TRANS, N, K, ALPHA, 202081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ LDA, LDB, BETA, LDC) 202181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 202281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 160 CONTINUE 202381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 202481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 202581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', 202681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 202781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 202881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', 202981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', 203081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'RATIO ', F8.2, ' - SUSPECT *******' ) 203181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', 203281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 203381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', 203481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' (', I6, ' CALL', 'S)' ) 203581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', 203681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'ANGED INCORRECTLY *******' ) 203781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) 203881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) 203981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), 204081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', 204181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ' .' ) 204281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', 204381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ '******' ) 204481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 204581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DCHK5. 204681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 204781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 204881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 204981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, 205081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ N, K, ALPHA, LDA, LDB, BETA, LDC) 205181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC 205281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, BETA 205381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 UPLO, TRANSA 205481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*12 SNAME 205581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*14 CRC, CU, CA 205681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 205781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (UPLO.EQ.'U')THEN 205881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasUpper' 205981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 206081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CU = ' CblasLower' 206181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 206281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (TRANSA.EQ.'N')THEN 206381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = ' CblasNoTrans' 206481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF (TRANSA.EQ.'T')THEN 206581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = ' CblasTrans' 206681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 206781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CA = 'CblasConjTrans' 206881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 206981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF (IORDER.EQ.1)THEN 207081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasRowMajor' 207181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 207281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CRC = ' CblasColMajor' 207381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 207481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA 207581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC 207681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 207781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) 207881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9994 FORMAT( 20X, 2( I3, ',' ), 207981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) 208081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 208181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 208281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET, 208381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ TRANSL ) 208481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 208581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generates values for an M by N matrix A. 208681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Stores the values in the array AA in the data structure required 208781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* by the routine, with unwanted elements set to rogue value. 208881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 208981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* TYPE is 'GE', 'SY' or 'TR'. 209081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 209181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 209281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 209381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 209481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 209581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 209681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 209781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 209881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 209981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 210081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO, ONE 210181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 210281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ROGUE 210381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ROGUE = -1.0D10 ) 210481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 210581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION TRANSL 210681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER LDA, M, N, NMAX 210781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL RESET 210881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 DIAG, UPLO 210981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*2 TYPE 211081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 211181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION A( NMAX, * ), AA( * ) 211281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 211381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IBEG, IEND, J 211481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL GEN, LOWER, SYM, TRI, UNIT, UPPER 211581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. External Functions .. 211681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION DBEG 211781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray EXTERNAL DBEG 211881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 211981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GEN = TYPE.EQ.'GE' 212081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SYM = TYPE.EQ.'SY' 212181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRI = TYPE.EQ.'TR' 212281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPPER = ( SYM.OR.TRI ).AND.UPLO.EQ.'U' 212381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOWER = ( SYM.OR.TRI ).AND.UPLO.EQ.'L' 212481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UNIT = TRI.AND.DIAG.EQ.'U' 212581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 212681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generate data in array A. 212781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 212881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 J = 1, N 212981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, M 213081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) ) 213181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ THEN 213281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray A( I, J ) = DBEG( RESET ) + TRANSL 213381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( I.NE.J )THEN 213481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Set some elements to zero 213581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( N.GT.3.AND.J.EQ.N/2 ) 213681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( I, J ) = ZERO 213781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( SYM )THEN 213881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray A( J, I ) = A( I, J ) 213981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( TRI )THEN 214081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray A( J, I ) = ZERO 214181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 214281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 214381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 214481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 214581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TRI ) 214681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( J, J ) = A( J, J ) + ONE 214781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UNIT ) 214881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ A( J, J ) = ONE 214981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 215081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 215181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Store elements in array AS in data structure required by routine. 215281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 215381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TYPE.EQ.'GE' )THEN 215481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 J = 1, N 215581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, M 215681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AA( I + ( J - 1 )*LDA ) = A( I, J ) 215781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 215881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = M + 1, LDA 215981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AA( I + ( J - 1 )*LDA ) = ROGUE 216081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 216181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 216281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN 216381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 J = 1, N 216481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UPPER )THEN 216581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IBEG = 1 216681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UNIT )THEN 216781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IEND = J - 1 216881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 216981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IEND = J 217081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 217181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 217281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UNIT )THEN 217381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IBEG = J + 1 217481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 217581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IBEG = J 217681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 217781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IEND = N 217881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 217981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 I = 1, IBEG - 1 218081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AA( I + ( J - 1 )*LDA ) = ROGUE 218181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 218281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 I = IBEG, IEND 218381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AA( I + ( J - 1 )*LDA ) = A( I, J ) 218481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 218581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 I = IEND + 1, LDA 218681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray AA( I + ( J - 1 )*LDA ) = ROGUE 218781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 218881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 218981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 219081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 219181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 219281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DMAKE. 219381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 219481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 219581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SUBROUTINE DMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, 219681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, 219781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ NOUT, MV ) 219881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 219981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Checks the results of the computational tests. 220081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 220181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 220281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 220381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 220481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 220581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 220681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 220781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 220881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 220981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Parameters .. 221081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ZERO, ONE 221181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 221281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 221381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ALPHA, BETA, EPS, ERR 221481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER KK, LDA, LDB, LDC, LDCC, M, N, NOUT 221581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FATAL, MV 221681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 TRANSA, TRANSB 221781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 221881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), 221981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ CC( LDCC, * ), CT( * ), G( * ) 222081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 222181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION ERRI 222281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, J, K 222381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL TRANA, TRANB 222481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Intrinsic Functions .. 222581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTRINSIC ABS, MAX, SQRT 222681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 222781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' 222881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' 222981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 223081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Compute expected result, one column at a time, in CT using data 223181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* in A, B and C. 223281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Compute gauges in G. 223381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 223481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 120 J = 1, N 223581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 223681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, M 223781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CT( I ) = ZERO 223881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray G( I ) = ZERO 223981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 224081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( .NOT.TRANA.AND..NOT.TRANB )THEN 224181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 K = 1, KK 224281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 I = 1, M 224381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CT( I ) = CT( I ) + A( I, K )*B( K, J ) 224481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) 224581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 224681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 224781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( TRANA.AND..NOT.TRANB )THEN 224881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 K = 1, KK 224981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = 1, M 225081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CT( I ) = CT( I ) + A( K, I )*B( K, J ) 225181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) 225281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 225381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 225481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( .NOT.TRANA.AND.TRANB )THEN 225581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 70 K = 1, KK 225681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 60 I = 1, M 225781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CT( I ) = CT( I ) + A( I, K )*B( J, K ) 225881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) 225981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 226081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 226181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( TRANA.AND.TRANB )THEN 226281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 90 K = 1, KK 226381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 80 I = 1, M 226481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CT( I ) = CT( I ) + A( K, I )*B( J, K ) 226581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) 226681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 CONTINUE 226781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 90 CONTINUE 226881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 226981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 100 I = 1, M 227081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) 227181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) 227281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 100 CONTINUE 227381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 227481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Compute the error ratio for this result. 227581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 227681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERR = ZERO 227781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 110 I = 1, M 227881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERRI = ABS( CT( I ) - CC( I, J ) )/EPS 227981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( G( I ).NE.ZERO ) 228081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ ERRI = ERRI/G( I ) 228181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ERR = MAX( ERR, ERRI ) 228281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( ERR*SQRT( EPS ).GE.ONE ) 228381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 130 228481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 110 CONTINUE 228581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 228681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 120 CONTINUE 228781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 228881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If the loop completes, all results are at least half accurate. 228981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 150 229081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 229181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Report fatal error. 229281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 229381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 130 FATAL = .TRUE. 229481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9999 ) 229581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 140 I = 1, M 229681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( MV )THEN 229781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) 229881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 229981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) 230081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 230181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 140 CONTINUE 230281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( N.GT.1 ) 230381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ WRITE( NOUT, FMT = 9997 )J 230481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 230581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 150 CONTINUE 230681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 230781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 230881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', 230981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', 231081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ 'TED RESULT' ) 231181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9998 FORMAT( 1X, I7, 2G18.6 ) 231281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) 231381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 231481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DMMCH. 231581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 231681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 231781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FUNCTION LDE( RI, RJ, LR ) 231881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 231981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests if two arrays are identical. 232081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 232181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 232281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 232381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 232481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 232581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 232681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 232781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 232881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 232981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 233081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER LR 233181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 233281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION RI( * ), RJ( * ) 233381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 233481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I 233581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 233681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = 1, LR 233781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( RI( I ).NE.RJ( I ) ) 233881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 20 233981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 234081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDE = .TRUE. 234181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 30 234281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 234381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDE = .FALSE. 234481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 RETURN 234581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 234681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of LDE. 234781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 234881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 234981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL FUNCTION LDERES( TYPE, UPLO, M, N, AA, AS, LDA ) 235081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 235181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Tests if selected elements in two arrays are equal. 235281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 235381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* TYPE is 'GE' or 'SY'. 235481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 235581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 235681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 235781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 235881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 235981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 236081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 236181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 236281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 236381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 236481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER LDA, M, N 236581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*1 UPLO 236681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray CHARACTER*2 TYPE 236781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Array Arguments .. 236881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION AA( LDA, * ), AS( LDA, * ) 236981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 237081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IBEG, IEND, J 237181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL UPPER 237281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 237381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray UPPER = UPLO.EQ.'U' 237481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( TYPE.EQ.'GE' )THEN 237581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 20 J = 1, N 237681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 10 I = M + 1, LDA 237781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( AA( I, J ).NE.AS( I, J ) ) 237881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 70 237981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 CONTINUE 238081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 20 CONTINUE 238181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE IF( TYPE.EQ.'SY' )THEN 238281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 50 J = 1, N 238381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( UPPER )THEN 238481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IBEG = 1 238581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IEND = J 238681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray ELSE 238781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IBEG = J 238881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IEND = N 238981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 239081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 30 I = 1, IBEG - 1 239181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( AA( I, J ).NE.AS( I, J ) ) 239281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 70 239381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 30 CONTINUE 239481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DO 40 I = IEND + 1, LDA 239581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( AA( I, J ).NE.AS( I, J ) ) 239681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray $ GO TO 70 239781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 40 CONTINUE 239881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 50 CONTINUE 239981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 240081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 240181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 60 CONTINUE 240281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDERES = .TRUE. 240381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 80 240481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 70 CONTINUE 240581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LDERES = .FALSE. 240681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 80 RETURN 240781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 240881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of LDERES. 240981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 241081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 241181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION FUNCTION DBEG( RESET ) 241281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 241381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Generates random numbers uniformly distributed between -0.5 and 0.5. 241481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 241581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 241681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 241781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 241881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 241981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 242081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 242181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 242281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 242381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 242481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray LOGICAL RESET 242581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Local Scalars .. 242681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray INTEGER I, IC, MI 242781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Save statement .. 242881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray SAVE I, IC, MI 242981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 243081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( RESET )THEN 243181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Initialize local variables. 243281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray MI = 891 243381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray I = 7 243481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IC = 0 243581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RESET = .FALSE. 243681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 243781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 243881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* The sequence of values of I is bounded between 1 and 999. 243981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If initial I = 1,2,3,6,7 or 9, the period will be 50. 244081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If initial I = 4 or 8, the period will be 25. 244181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* If initial I = 5, the period will be 10. 244281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* IC is used to break up the period by skipping 1 value of I in 6. 244381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 244481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IC = IC + 1 244581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray 10 I = I*MI 244681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray I = I - 1000*( I/1000 ) 244781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IF( IC.GE.5 )THEN 244881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray IC = 0 244981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray GO TO 10 245081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END IF 245181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DBEG = ( I - 500 )/1001.0D0 245281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 245381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 245481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DBEG. 245581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 245681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 245781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION FUNCTION DDIFF( X, Y ) 245881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 245981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Auxiliary routine for test program for Level 3 Blas. 246081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 246181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* -- Written on 8-February-1989. 246281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jack Dongarra, Argonne National Laboratory. 246381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Iain Duff, AERE Harwell. 246481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Jeremy Du Croz, Numerical Algorithms Group Ltd. 246581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* Sven Hammarling, Numerical Algorithms Group Ltd. 246681253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 246781253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Scalar Arguments .. 246881253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DOUBLE PRECISION X, Y 246981253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* .. Executable Statements .. 247081253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray DDIFF = X - Y 247181253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray RETURN 247281253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 247381253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* End of DDIFF. 247481253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray* 247581253e9afbc34b99e9adc22ddf33a1bfac56c697Tim Murray END 2476