floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update BLAS tests to correspond to Reference-LAPACK 3.9.0 

replaces calculation of machine precision with call to epsilon intrinsic and removes the requirement for previous output files to be removed before rerunning tests
This commit is contained in:
Martin Kroeker 2020-06-14 10:26:25 +02:00 committed by GitHub
parent 63d26090f5
commit 18a11137f1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 1036 additions and 592 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
test/cblat1.f
View File

@ -1,7 +1,49 @@
*> \brief \b CBLAT1
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM CBLAT1
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX Level 1 BLAS.
*> Based upon the original BLAS test routine together with:
*>
*> F06GAF Example Program Text
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex_blas_testing
*
* =====================================================================
PROGRAM CBLAT1 PROGRAM CBLAT1
* Test program for the COMPLEX Level 1 BLAS. *
* Based upon the original BLAS test routine together with: * -- Reference BLAS test routine (version 3.7.0) --
* F06GAF Example Program Text * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* =====================================================================
*
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) PARAMETER (NOUT=6)
@ -114,8 +156,8 @@
+ (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0), + (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0),
+ (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0), + (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0),
+ (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0), + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+ (7.0E0,8.0E0), (0.3E0,0.1E0), (0.1E0,0.4E0), + (7.0E0,8.0E0), (0.3E0,0.1E0), (0.5E0,0.0E0),
+ (0.4E0,0.1E0), (0.1E0,0.2E0), (2.0E0,3.0E0), + (0.0E0,0.5E0), (0.0E0,0.2E0), (2.0E0,3.0E0),
+ (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/ + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0), DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
+ (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
@ -129,10 +171,10 @@
+ (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0), + (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0),
+ (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0), + (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
+ (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0), + (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0),
+ (0.1E0,0.4E0), (6.0E0,9.0E0), (0.4E0,0.1E0), + (0.5E0,0.0E0), (6.0E0,9.0E0), (0.0E0,0.5E0),
+ (8.0E0,3.0E0), (0.1E0,0.2E0), (9.0E0,4.0E0)/ + (8.0E0,3.0E0), (0.0E0,0.2E0), (9.0E0,4.0E0)/
DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.7E0/ DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.8E0/
DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.7E0/ DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.6E0/
DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0), DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
+ (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+ (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
@ -145,8 +187,8 @@
+ (0.11E0,-0.03E0), (-0.17E0,0.46E0), + (0.11E0,-0.03E0), (-0.17E0,0.46E0),
+ (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0), + (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+ (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0), + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+ (0.19E0,-0.17E0), (0.32E0,0.09E0), + (0.19E0,-0.17E0), (0.20E0,-0.35E0),
+ (0.23E0,-0.24E0), (0.18E0,0.01E0), + (0.35E0,0.20E0), (0.14E0,0.08E0),
+ (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0), + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0),
+ (2.0E0,3.0E0)/ + (2.0E0,3.0E0)/
DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0), DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
@ -162,9 +204,9 @@
+ (-0.17E0,0.46E0), (4.0E0,7.0E0), + (-0.17E0,0.46E0), (4.0E0,7.0E0),
+ (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0), + (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
+ (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0), + (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0),
+ (0.32E0,0.09E0), (6.0E0,9.0E0), + (0.20E0,-0.35E0), (6.0E0,9.0E0),
+ (0.23E0,-0.24E0), (8.0E0,3.0E0), + (0.35E0,0.20E0), (8.0E0,3.0E0),
+ (0.18E0,0.01E0), (9.0E0,4.0E0)/ + (0.14E0,0.08E0), (9.0E0,4.0E0)/
DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0), DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
+ (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
+ (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0), + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
@ -177,8 +219,8 @@
+ (0.03E0,0.03E0), (-0.18E0,0.03E0), + (0.03E0,0.03E0), (-0.18E0,0.03E0),
+ (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0), + (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+ (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0), + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
+ (0.09E0,0.03E0), (0.03E0,0.12E0), + (0.09E0,0.03E0), (0.15E0,0.00E0),
+ (0.12E0,0.03E0), (0.03E0,0.06E0), (2.0E0,3.0E0), + (0.00E0,0.15E0), (0.00E0,0.06E0), (2.0E0,3.0E0),
+ (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/ + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0), DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
+ (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0), + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
@ -193,8 +235,8 @@
+ (-0.18E0,0.03E0), (4.0E0,7.0E0), + (-0.18E0,0.03E0), (4.0E0,7.0E0),
+ (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0), + (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
+ (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0), + (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0),
+ (0.03E0,0.12E0), (6.0E0,9.0E0), (0.12E0,0.03E0), + (0.15E0,0.00E0), (6.0E0,9.0E0), (0.00E0,0.15E0),
+ (8.0E0,3.0E0), (0.03E0,0.06E0), (9.0E0,4.0E0)/ + (8.0E0,3.0E0), (0.00E0,0.06E0), (9.0E0,4.0E0)/
DATA ITRUE3/0, 1, 2, 2, 2/ DATA ITRUE3/0, 1, 2, 2, 2/
* .. Executable Statements .. * .. Executable Statements ..
DO 60 INCX = 1, 2 DO 60 INCX = 1, 2
@ -529,7 +571,8 @@
* *
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) REAL ZERO
PARAMETER (NOUT=6, ZERO=0.0E0)
* .. Scalar Arguments .. * .. Scalar Arguments ..
REAL SFAC REAL SFAC
INTEGER LEN INTEGER LEN
@ -552,7 +595,7 @@
* *
DO 40 I = 1, LEN DO 40 I = 1, LEN
SD = SCOMP(I) - STRUE(I) SD = SCOMP(I) - STRUE(I)
IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
+ GO TO 40 + GO TO 40
* *
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).

188
test/cblat2.f
View File

@ -1,68 +1,114 @@
*> \brief \b CBLAT2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM CBLAT2
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX Level 2 Blas.
*>
*> The program must be driven by a short data file. The first 18 records
*> of the file are read using list-directed input, the last 17 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 35 lines:
*> 'cblat2.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'CBLA2T.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 4 NUMBER OF VALUES OF K
*> 0 1 2 4 VALUES OF K
*> 4 NUMBER OF VALUES OF INCX AND INCY
*> 1 2 -1 -2 VALUES OF INCX AND INCY
*> 3 NUMBER OF VALUES OF ALPHA
*> (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
*> CGEMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CGBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CHEMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CHBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CHPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CTRMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CTBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CTPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> CTRSV T PUT F FOR NO TEST. SAME COLUMNS.
*> CTBSV T PUT F FOR NO TEST. SAME COLUMNS.
*> CTPSV T PUT F FOR NO TEST. SAME COLUMNS.
*> CGERC T PUT F FOR NO TEST. SAME COLUMNS.
*> CGERU T PUT F FOR NO TEST. SAME COLUMNS.
*> CHER T PUT F FOR NO TEST. SAME COLUMNS.
*> CHPR T PUT F FOR NO TEST. SAME COLUMNS.
*> CHER2 T PUT F FOR NO TEST. SAME COLUMNS.
*> CHPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
*> An extended set of Fortran Basic Linear Algebra Subprograms.
*>
*> Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
*> and Computer Science Division, Argonne National Laboratory,
*> 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> Or
*>
*> NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
*> Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
*> OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
*> Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*>
*>
*> -- Written on 10-August-1987.
*> Richard Hanson, Sandia National Labs.
*> Jeremy Du Croz, NAG Central Office.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex_blas_testing
*
* =====================================================================
PROGRAM CBLAT2 PROGRAM CBLAT2
* *
* Test program for the COMPLEX Level 2 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 18 records * =====================================================================
* of the file are read using list-directed input, the last 17 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 35 lines:
* 'CBLAT2.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'CBLA2T.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 4 NUMBER OF VALUES OF K
* 0 1 2 4 VALUES OF K
* 4 NUMBER OF VALUES OF INCX AND INCY
* 1 2 -1 -2 VALUES OF INCX AND INCY
* 3 NUMBER OF VALUES OF ALPHA
* (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
* CGEMV T PUT F FOR NO TEST. SAME COLUMNS.
* CGBMV T PUT F FOR NO TEST. SAME COLUMNS.
* CHEMV T PUT F FOR NO TEST. SAME COLUMNS.
* CHBMV T PUT F FOR NO TEST. SAME COLUMNS.
* CHPMV T PUT F FOR NO TEST. SAME COLUMNS.
* CTRMV T PUT F FOR NO TEST. SAME COLUMNS.
* CTBMV T PUT F FOR NO TEST. SAME COLUMNS.
* CTPMV T PUT F FOR NO TEST. SAME COLUMNS.
* CTRSV T PUT F FOR NO TEST. SAME COLUMNS.
* CTBSV T PUT F FOR NO TEST. SAME COLUMNS.
* CTPSV T PUT F FOR NO TEST. SAME COLUMNS.
* CGERC T PUT F FOR NO TEST. SAME COLUMNS.
* CGERU T PUT F FOR NO TEST. SAME COLUMNS.
* CHER T PUT F FOR NO TEST. SAME COLUMNS.
* CHPR T PUT F FOR NO TEST. SAME COLUMNS.
* CHER2 T PUT F FOR NO TEST. SAME COLUMNS.
* CHPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
* An extended set of Fortran Basic Linear Algebra Subprograms.
*
* Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
* and Computer Science Division, Argonne National Laboratory,
* 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*
* Or
*
* NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
* Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
* OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
* Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*
*
* -- Written on 10-August-1987.
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
@ -71,8 +117,8 @@
PARAMETER ( NSUBS = 17 ) PARAMETER ( NSUBS = 17 )
COMPLEX ZERO, ONE COMPLEX ZERO, ONE
PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) ) PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
REAL RZERO, RHALF, RONE REAL RZERO
PARAMETER ( RZERO = 0.0, RHALF = 0.5, RONE = 1.0 ) PARAMETER ( RZERO = 0.0 )
INTEGER NMAX, INCMAX INTEGER NMAX, INCMAX
PARAMETER ( NMAX = 65, INCMAX = 2 ) PARAMETER ( NMAX = 65, INCMAX = 2 )
INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
@ -126,7 +172,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -135,7 +181,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -240,14 +286,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = RONE EPS = EPSILON(RZERO)
90 CONTINUE
IF( SDIFF( RONE + EPS, RONE ).EQ.RZERO )
$ GO TO 100
EPS = RHALF*EPS
GO TO 90
100 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of CMVCH using exact data. * Check the reliability of CMVCH using exact data.
@ -3079,7 +3118,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LCERES = .TRUE. LCERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

187
test/cblat3.f
View File

@ -1,50 +1,96 @@
*> \brief \b CBLAT3
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM CBLAT3
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX Level 3 Blas.
*>
*> The program must be driven by a short data file. The first 14 records
*> of the file are read using list-directed input, the last 9 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 23 lines:
*> 'cblat3.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 3 NUMBER OF VALUES OF ALPHA
*> (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
*> CGEMM T PUT F FOR NO TEST. SAME COLUMNS.
*> CHEMM T PUT F FOR NO TEST. SAME COLUMNS.
*> CSYMM T PUT F FOR NO TEST. SAME COLUMNS.
*> CTRMM T PUT F FOR NO TEST. SAME COLUMNS.
*> CTRSM T PUT F FOR NO TEST. SAME COLUMNS.
*> CHERK T PUT F FOR NO TEST. SAME COLUMNS.
*> CSYRK T PUT F FOR NO TEST. SAME COLUMNS.
*> CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
*> CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
*> A Set of Level 3 Basic Linear Algebra Subprograms.
*>
*> Technical Memorandum No.88 (Revision 1), Mathematics and
*> Computer Science Division, Argonne National Laboratory, 9700
*> South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> -- Written on 8-February-1989.
*> Jack Dongarra, Argonne National Laboratory.
*> Iain Duff, AERE Harwell.
*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
*> Sven Hammarling, Numerical Algorithms Group Ltd.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex_blas_testing
*
* =====================================================================
PROGRAM CBLAT3 PROGRAM CBLAT3
* *
* Test program for the COMPLEX Level 3 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 14 records * =====================================================================
* of the file are read using list-directed input, the last 9 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 23 lines:
* 'CBLAT3.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 3 NUMBER OF VALUES OF ALPHA
* (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
* CGEMM T PUT F FOR NO TEST. SAME COLUMNS.
* CHEMM T PUT F FOR NO TEST. SAME COLUMNS.
* CSYMM T PUT F FOR NO TEST. SAME COLUMNS.
* CTRMM T PUT F FOR NO TEST. SAME COLUMNS.
* CTRSM T PUT F FOR NO TEST. SAME COLUMNS.
* CHERK T PUT F FOR NO TEST. SAME COLUMNS.
* CSYRK T PUT F FOR NO TEST. SAME COLUMNS.
* CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
* CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
* A Set of Level 3 Basic Linear Algebra Subprograms.
*
* Technical Memorandum No.88 (Revision 1), Mathematics and
* Computer Science Division, Argonne National Laboratory, 9700
* South Cass Avenue, Argonne, Illinois 60439, US.
*
* -- Written on 8-February-1989.
* Jack Dongarra, Argonne National Laboratory.
* Iain Duff, AERE Harwell.
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
@ -53,8 +99,8 @@
PARAMETER ( NSUBS = 9 ) PARAMETER ( NSUBS = 9 )
COMPLEX ZERO, ONE COMPLEX ZERO, ONE
PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) ) PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
REAL RZERO, RHALF, RONE REAL RZERO
PARAMETER ( RZERO = 0.0, RHALF = 0.5, RONE = 1.0 ) PARAMETER ( RZERO = 0.0 )
INTEGER NMAX INTEGER NMAX
PARAMETER ( NMAX = 65 ) PARAMETER ( NMAX = 65 )
INTEGER NIDMAX, NALMAX, NBEMAX INTEGER NIDMAX, NALMAX, NBEMAX
@ -103,7 +149,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -112,7 +158,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -189,14 +235,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = RONE EPS = EPSILON(RZERO)
70 CONTINUE
IF( SDIFF( RONE + EPS, RONE ).EQ.RZERO )
$ GO TO 80
EPS = RHALF*EPS
GO TO 70
80 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of CMMCH using exact data. * Check the reliability of CMMCH using exact data.
@ -1301,8 +1340,6 @@
NC = 0 NC = 0
RESET = .TRUE. RESET = .TRUE.
ERRMAX = RZERO ERRMAX = RZERO
RALS = RONE
RBETS = RONE
* *
DO 100 IN = 1, NIDIM DO 100 IN = 1, NIDIM
N = IDIM( IN ) N = IDIM( IN )
@ -1948,7 +1985,7 @@
* *
* Tests the error exits from the Level 3 Blas. * Tests the error exits from the Level 3 Blas.
* Requires a special version of the error-handling routine XERBLA. * Requires a special version of the error-handling routine XERBLA.
* ALPHA, RALPHA, BETA, RBETA, A, B and C should not need to be defined. * A, B and C should not need to be defined.
* *
* Auxiliary routine for test program for Level 3 Blas. * Auxiliary routine for test program for Level 3 Blas.
* *
@ -1958,12 +1995,19 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd. * Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* 3-19-92: Initialize ALPHA, BETA, RALPHA, and RBETA (eca)
* 3-19-92: Fix argument 12 in calls to CSYMM and CHEMM
* with INFOT = 9 (eca)
*
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER ISNUM, NOUT INTEGER ISNUM, NOUT
CHARACTER*6 SRNAMT CHARACTER*6 SRNAMT
* .. Scalars in Common .. * .. Scalars in Common ..
INTEGER INFOT, NOUTC INTEGER INFOT, NOUTC
LOGICAL LERR, OK LOGICAL LERR, OK
* .. Parameters ..
REAL ONE, TWO
PARAMETER ( ONE = 1.0E0, TWO = 2.0E0 )
* .. Local Scalars .. * .. Local Scalars ..
COMPLEX ALPHA, BETA COMPLEX ALPHA, BETA
REAL RALPHA, RBETA REAL RALPHA, RBETA
@ -1981,6 +2025,14 @@
* LERR is set to .TRUE. by the special version of XERBLA each time * LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER. * it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE. LERR = .FALSE.
*
* Initialize ALPHA, BETA, RALPHA, and RBETA.
*
ALPHA = CMPLX( ONE, -ONE )
BETA = CMPLX( TWO, -TWO )
RALPHA = ONE
RBETA = TWO
*
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90 )ISNUM $ 90 )ISNUM
10 INFOT = 1 10 INFOT = 1
@ -2207,16 +2259,16 @@
CALL CHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 12 INFOT = 12
CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
@ -2274,16 +2326,16 @@
CALL CSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 12 INFOT = 12
CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
@ -3270,7 +3322,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LCERES = .TRUE. LCERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

186
test/dblat2.f
View File

@ -1,75 +1,121 @@
*> \brief \b DBLAT2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM DBLAT2
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the DOUBLE PRECISION Level 2 Blas.
*>
*> The program must be driven by a short data file. The first 18 records
*> of the file are read using list-directed input, the last 16 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 34 lines:
*> 'dblat2.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'DBLAT2.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 4 NUMBER OF VALUES OF K
*> 0 1 2 4 VALUES OF K
*> 4 NUMBER OF VALUES OF INCX AND INCY
*> 1 2 -1 -2 VALUES OF INCX AND INCY
*> 3 NUMBER OF VALUES OF ALPHA
*> 0.0 1.0 0.7 VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> 0.0 1.0 0.9 VALUES OF BETAC
*> DGEMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DGBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DSYMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DSBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DSPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DTRMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DTBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DTPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> DTRSV T PUT F FOR NO TEST. SAME COLUMNS.
*> DTBSV T PUT F FOR NO TEST. SAME COLUMNS.
*> DTPSV T PUT F FOR NO TEST. SAME COLUMNS.
*> DGER T PUT F FOR NO TEST. SAME COLUMNS.
*> DSYR T PUT F FOR NO TEST. SAME COLUMNS.
*> DSPR T PUT F FOR NO TEST. SAME COLUMNS.
*> DSYR2 T PUT F FOR NO TEST. SAME COLUMNS.
*> DSPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
*> An extended set of Fortran Basic Linear Algebra Subprograms.
*>
*> Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
*> and Computer Science Division, Argonne National Laboratory,
*> 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> Or
*>
*> NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
*> Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
*> OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
*> Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*>
*>
*> -- Written on 10-August-1987.
*> Richard Hanson, Sandia National Labs.
*> Jeremy Du Croz, NAG Central Office.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup double_blas_testing
*
* =====================================================================
PROGRAM DBLAT2 PROGRAM DBLAT2
* *
* Test program for the DOUBLE PRECISION Level 2 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 18 records * =====================================================================
* of the file are read using list-directed input, the last 16 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 34 lines:
* 'DBLAT2.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'DBLAT2.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 4 NUMBER OF VALUES OF K
* 0 1 2 4 VALUES OF K
* 4 NUMBER OF VALUES OF INCX AND INCY
* 1 2 -1 -2 VALUES OF INCX AND INCY
* 3 NUMBER OF VALUES OF ALPHA
* 0.0 1.0 0.7 VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* 0.0 1.0 0.9 VALUES OF BETA
* DGEMV T PUT F FOR NO TEST. SAME COLUMNS.
* DGBMV T PUT F FOR NO TEST. SAME COLUMNS.
* DSYMV T PUT F FOR NO TEST. SAME COLUMNS.
* DSBMV T PUT F FOR NO TEST. SAME COLUMNS.
* DSPMV T PUT F FOR NO TEST. SAME COLUMNS.
* DTRMV T PUT F FOR NO TEST. SAME COLUMNS.
* DTBMV T PUT F FOR NO TEST. SAME COLUMNS.
* DTPMV T PUT F FOR NO TEST. SAME COLUMNS.
* DTRSV T PUT F FOR NO TEST. SAME COLUMNS.
* DTBSV T PUT F FOR NO TEST. SAME COLUMNS.
* DTPSV T PUT F FOR NO TEST. SAME COLUMNS.
* DGER T PUT F FOR NO TEST. SAME COLUMNS.
* DSYR T PUT F FOR NO TEST. SAME COLUMNS.
* DSPR T PUT F FOR NO TEST. SAME COLUMNS.
* DSYR2 T PUT F FOR NO TEST. SAME COLUMNS.
* DSPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
* An extended set of Fortran Basic Linear Algebra Subprograms.
*
* Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
* and Computer Science Division, Argonne National Laboratory,
* 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*
* Or
*
* NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
* Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
* OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
* Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*
*
* -- Written on 10-August-1987.
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
PARAMETER ( NIN = 5 ) PARAMETER ( NIN = 5 )
INTEGER NSUBS INTEGER NSUBS
PARAMETER ( NSUBS = 16 ) PARAMETER ( NSUBS = 16 )
DOUBLE PRECISION ZERO, HALF, ONE DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
INTEGER NMAX, INCMAX INTEGER NMAX, INCMAX
PARAMETER ( NMAX = 65, INCMAX = 2 ) PARAMETER ( NMAX = 65, INCMAX = 2 )
INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
@ -121,7 +167,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -130,7 +176,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -235,14 +281,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = ONE EPS = EPSILON(ZERO)
90 CONTINUE
IF( DDIFF( ONE + EPS, ONE ).EQ.ZERO )
$ GO TO 100
EPS = HALF*EPS
GO TO 90
100 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of DMVCH using exact data. * Check the reliability of DMVCH using exact data.
@ -2982,7 +3021,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LDERES = .TRUE. LDERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

168
test/dblat3.f
View File

@ -1,55 +1,101 @@
*> \brief \b DBLAT3
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM DBLAT3
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the DOUBLE PRECISION Level 3 Blas.
*>
*> The program must be driven by a short data file. The first 14 records
*> of the file are read using list-directed input, the last 6 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 20 lines:
*> 'dblat3.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 3 NUMBER OF VALUES OF ALPHA
*> 0.0 1.0 0.7 VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> 0.0 1.0 1.3 VALUES OF BETA
*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
*> A Set of Level 3 Basic Linear Algebra Subprograms.
*>
*> Technical Memorandum No.88 (Revision 1), Mathematics and
*> Computer Science Division, Argonne National Laboratory, 9700
*> South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> -- Written on 8-February-1989.
*> Jack Dongarra, Argonne National Laboratory.
*> Iain Duff, AERE Harwell.
*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
*> Sven Hammarling, Numerical Algorithms Group Ltd.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup double_blas_testing
*
* =====================================================================
PROGRAM DBLAT3 PROGRAM DBLAT3
* *
* Test program for the DOUBLE PRECISION Level 3 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 14 records * =====================================================================
* of the file are read using list-directed input, the last 6 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 20 lines:
* 'DBLAT3.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 3 NUMBER OF VALUES OF ALPHA
* 0.0 1.0 0.7 VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* 0.0 1.0 1.3 VALUES OF BETA
* DGEMM T PUT F FOR NO TEST. SAME COLUMNS.
* DSYMM T PUT F FOR NO TEST. SAME COLUMNS.
* DTRMM T PUT F FOR NO TEST. SAME COLUMNS.
* DTRSM T PUT F FOR NO TEST. SAME COLUMNS.
* DSYRK T PUT F FOR NO TEST. SAME COLUMNS.
* DSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
* A Set of Level 3 Basic Linear Algebra Subprograms.
*
* Technical Memorandum No.88 (Revision 1), Mathematics and
* Computer Science Division, Argonne National Laboratory, 9700
* South Cass Avenue, Argonne, Illinois 60439, US.
*
* -- Written on 8-February-1989.
* Jack Dongarra, Argonne National Laboratory.
* Iain Duff, AERE Harwell.
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
PARAMETER ( NIN = 5 ) PARAMETER ( NIN = 5 )
INTEGER NSUBS INTEGER NSUBS
PARAMETER ( NSUBS = 6 ) PARAMETER ( NSUBS = 6 )
DOUBLE PRECISION ZERO, HALF, ONE DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
INTEGER NMAX INTEGER NMAX
PARAMETER ( NMAX = 65 ) PARAMETER ( NMAX = 65 )
INTEGER NIDMAX, NALMAX, NBEMAX INTEGER NIDMAX, NALMAX, NBEMAX
@ -96,7 +142,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -105,7 +151,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -182,14 +228,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = ONE EPS = EPSILON(ZERO)
70 CONTINUE
IF( DDIFF( ONE + EPS, ONE ).EQ.ZERO )
$ GO TO 80
EPS = HALF*EPS
GO TO 70
80 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of DMMCH using exact data. * Check the reliability of DMMCH using exact data.
@ -1802,7 +1841,7 @@
* *
* Tests the error exits from the Level 3 Blas. * Tests the error exits from the Level 3 Blas.
* Requires a special version of the error-handling routine XERBLA. * Requires a special version of the error-handling routine XERBLA.
* ALPHA, BETA, A, B and C should not need to be defined. * A, B and C should not need to be defined.
* *
* Auxiliary routine for test program for Level 3 Blas. * Auxiliary routine for test program for Level 3 Blas.
* *
@ -1812,12 +1851,18 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd. * Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* 3-19-92: Initialize ALPHA and BETA (eca)
* 3-19-92: Fix argument 12 in calls to SSYMM with INFOT = 9 (eca)
*
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER ISNUM, NOUT INTEGER ISNUM, NOUT
CHARACTER*6 SRNAMT CHARACTER*6 SRNAMT
* .. Scalars in Common .. * .. Scalars in Common ..
INTEGER INFOT, NOUTC INTEGER INFOT, NOUTC
LOGICAL LERR, OK LOGICAL LERR, OK
* .. Parameters ..
DOUBLE PRECISION ONE, TWO
PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 )
* .. Local Scalars .. * .. Local Scalars ..
DOUBLE PRECISION ALPHA, BETA DOUBLE PRECISION ALPHA, BETA
* .. Local Arrays .. * .. Local Arrays ..
@ -1834,6 +1879,12 @@
* LERR is set to .TRUE. by the special version of XERBLA each time * LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER. * it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE. LERR = .FALSE.
*
* Initialize ALPHA and BETA.
*
ALPHA = ONE
BETA = TWO
*
GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM
10 INFOT = 1 10 INFOT = 1
CALL DGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL DGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
@ -1963,16 +2014,16 @@
CALL DSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL DSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL DSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL DSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL DSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL DSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 12 INFOT = 12
CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL DSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
@ -2660,7 +2711,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LDERES = .TRUE. LDERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

186
test/sblat2.f
View File

@ -1,75 +1,121 @@
*> \brief \b SBLAT2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM SBLAT2
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the REAL Level 2 Blas.
*>
*> The program must be driven by a short data file. The first 18 records
*> of the file are read using list-directed input, the last 16 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 34 lines:
*> 'sblat2.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'SBLAT2.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 4 NUMBER OF VALUES OF K
*> 0 1 2 4 VALUES OF K
*> 4 NUMBER OF VALUES OF INCX AND INCY
*> 1 2 -1 -2 VALUES OF INCX AND INCY
*> 3 NUMBER OF VALUES OF ALPHA
*> 0.0 1.0 0.7 VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> 0.0 1.0 0.9 VALUES OF BETA
*> SGEMV T PUT F FOR NO TEST. SAME COLUMNS.
*> SGBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> SSYMV T PUT F FOR NO TEST. SAME COLUMNS.
*> SSBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> SSPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> STRMV T PUT F FOR NO TEST. SAME COLUMNS.
*> STBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> STPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> STRSV T PUT F FOR NO TEST. SAME COLUMNS.
*> STBSV T PUT F FOR NO TEST. SAME COLUMNS.
*> STPSV T PUT F FOR NO TEST. SAME COLUMNS.
*> SGER T PUT F FOR NO TEST. SAME COLUMNS.
*> SSYR T PUT F FOR NO TEST. SAME COLUMNS.
*> SSPR T PUT F FOR NO TEST. SAME COLUMNS.
*> SSYR2 T PUT F FOR NO TEST. SAME COLUMNS.
*> SSPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
*> An extended set of Fortran Basic Linear Algebra Subprograms.
*>
*> Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
*> and Computer Science Division, Argonne National Laboratory,
*> 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> Or
*>
*> NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
*> Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
*> OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
*> Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*>
*>
*> -- Written on 10-August-1987.
*> Richard Hanson, Sandia National Labs.
*> Jeremy Du Croz, NAG Central Office.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup single_blas_testing
*
* =====================================================================
PROGRAM SBLAT2 PROGRAM SBLAT2
* *
* Test program for the REAL Level 2 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 18 records * =====================================================================
* of the file are read using list-directed input, the last 16 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 34 lines:
* 'SBLAT2.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'SBLAT2.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 4 NUMBER OF VALUES OF K
* 0 1 2 4 VALUES OF K
* 4 NUMBER OF VALUES OF INCX AND INCY
* 1 2 -1 -2 VALUES OF INCX AND INCY
* 3 NUMBER OF VALUES OF ALPHA
* 0.0 1.0 0.7 VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* 0.0 1.0 0.9 VALUES OF BETA
* SGEMV T PUT F FOR NO TEST. SAME COLUMNS.
* SGBMV T PUT F FOR NO TEST. SAME COLUMNS.
* SSYMV T PUT F FOR NO TEST. SAME COLUMNS.
* SSBMV T PUT F FOR NO TEST. SAME COLUMNS.
* SSPMV T PUT F FOR NO TEST. SAME COLUMNS.
* STRMV T PUT F FOR NO TEST. SAME COLUMNS.
* STBMV T PUT F FOR NO TEST. SAME COLUMNS.
* STPMV T PUT F FOR NO TEST. SAME COLUMNS.
* STRSV T PUT F FOR NO TEST. SAME COLUMNS.
* STBSV T PUT F FOR NO TEST. SAME COLUMNS.
* STPSV T PUT F FOR NO TEST. SAME COLUMNS.
* SGER T PUT F FOR NO TEST. SAME COLUMNS.
* SSYR T PUT F FOR NO TEST. SAME COLUMNS.
* SSPR T PUT F FOR NO TEST. SAME COLUMNS.
* SSYR2 T PUT F FOR NO TEST. SAME COLUMNS.
* SSPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
* An extended set of Fortran Basic Linear Algebra Subprograms.
*
* Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
* and Computer Science Division, Argonne National Laboratory,
* 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*
* Or
*
* NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
* Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
* OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
* Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*
*
* -- Written on 10-August-1987.
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
PARAMETER ( NIN = 5 ) PARAMETER ( NIN = 5 )
INTEGER NSUBS INTEGER NSUBS
PARAMETER ( NSUBS = 16 ) PARAMETER ( NSUBS = 16 )
REAL ZERO, HALF, ONE REAL ZERO, ONE
PARAMETER ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 ) PARAMETER ( ZERO = 0.0, ONE = 1.0 )
INTEGER NMAX, INCMAX INTEGER NMAX, INCMAX
PARAMETER ( NMAX = 65, INCMAX = 2 ) PARAMETER ( NMAX = 65, INCMAX = 2 )
INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
@ -121,7 +167,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -130,7 +176,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -235,14 +281,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = ONE EPS = EPSILON(ZERO)
90 CONTINUE
IF( SDIFF( ONE + EPS, ONE ).EQ.ZERO )
$ GO TO 100
EPS = HALF*EPS
GO TO 90
100 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of SMVCH using exact data. * Check the reliability of SMVCH using exact data.
@ -2982,7 +3021,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LSERES = .TRUE. LSERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

168
test/sblat3.f
View File

@ -1,55 +1,101 @@
*> \brief \b SBLAT3
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM SBLAT3
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the REAL Level 3 Blas.
*>
*> The program must be driven by a short data file. The first 14 records
*> of the file are read using list-directed input, the last 6 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 20 lines:
*> 'sblat3.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'SBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 3 NUMBER OF VALUES OF ALPHA
*> 0.0 1.0 0.7 VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> 0.0 1.0 1.3 VALUES OF BETA
*> SGEMM T PUT F FOR NO TEST. SAME COLUMNS.
*> SSYMM T PUT F FOR NO TEST. SAME COLUMNS.
*> STRMM T PUT F FOR NO TEST. SAME COLUMNS.
*> STRSM T PUT F FOR NO TEST. SAME COLUMNS.
*> SSYRK T PUT F FOR NO TEST. SAME COLUMNS.
*> SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
*> A Set of Level 3 Basic Linear Algebra Subprograms.
*>
*> Technical Memorandum No.88 (Revision 1), Mathematics and
*> Computer Science Division, Argonne National Laboratory, 9700
*> South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> -- Written on 8-February-1989.
*> Jack Dongarra, Argonne National Laboratory.
*> Iain Duff, AERE Harwell.
*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
*> Sven Hammarling, Numerical Algorithms Group Ltd.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup single_blas_testing
*
* =====================================================================
PROGRAM SBLAT3 PROGRAM SBLAT3
* *
* Test program for the REAL Level 3 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 14 records * =====================================================================
* of the file are read using list-directed input, the last 6 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 20 lines:
* 'SBLAT3.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'SBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 3 NUMBER OF VALUES OF ALPHA
* 0.0 1.0 0.7 VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* 0.0 1.0 1.3 VALUES OF BETA
* SGEMM T PUT F FOR NO TEST. SAME COLUMNS.
* SSYMM T PUT F FOR NO TEST. SAME COLUMNS.
* STRMM T PUT F FOR NO TEST. SAME COLUMNS.
* STRSM T PUT F FOR NO TEST. SAME COLUMNS.
* SSYRK T PUT F FOR NO TEST. SAME COLUMNS.
* SSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
* A Set of Level 3 Basic Linear Algebra Subprograms.
*
* Technical Memorandum No.88 (Revision 1), Mathematics and
* Computer Science Division, Argonne National Laboratory, 9700
* South Cass Avenue, Argonne, Illinois 60439, US.
*
* -- Written on 8-February-1989.
* Jack Dongarra, Argonne National Laboratory.
* Iain Duff, AERE Harwell.
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
PARAMETER ( NIN = 5 ) PARAMETER ( NIN = 5 )
INTEGER NSUBS INTEGER NSUBS
PARAMETER ( NSUBS = 6 ) PARAMETER ( NSUBS = 6 )
REAL ZERO, HALF, ONE REAL ZERO, ONE
PARAMETER ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 ) PARAMETER ( ZERO = 0.0, ONE = 1.0 )
INTEGER NMAX INTEGER NMAX
PARAMETER ( NMAX = 65 ) PARAMETER ( NMAX = 65 )
INTEGER NIDMAX, NALMAX, NBEMAX INTEGER NIDMAX, NALMAX, NBEMAX
@ -96,7 +142,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -105,7 +151,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -182,14 +228,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = ONE EPS = EPSILON(ZERO)
70 CONTINUE
IF( SDIFF( ONE + EPS, ONE ).EQ.ZERO )
$ GO TO 80
EPS = HALF*EPS
GO TO 70
80 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of SMMCH using exact data. * Check the reliability of SMMCH using exact data.
@ -1802,7 +1841,7 @@
* *
* Tests the error exits from the Level 3 Blas. * Tests the error exits from the Level 3 Blas.
* Requires a special version of the error-handling routine XERBLA. * Requires a special version of the error-handling routine XERBLA.
* ALPHA, BETA, A, B and C should not need to be defined. * A, B and C should not need to be defined.
* *
* Auxiliary routine for test program for Level 3 Blas. * Auxiliary routine for test program for Level 3 Blas.
* *
@ -1812,12 +1851,18 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd. * Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* 3-19-92: Initialize ALPHA and BETA (eca)
* 3-19-92: Fix argument 12 in calls to SSYMM with INFOT = 9 (eca)
*
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER ISNUM, NOUT INTEGER ISNUM, NOUT
CHARACTER*6 SRNAMT CHARACTER*6 SRNAMT
* .. Scalars in Common .. * .. Scalars in Common ..
INTEGER INFOT, NOUTC INTEGER INFOT, NOUTC
LOGICAL LERR, OK LOGICAL LERR, OK
* .. Parameters ..
REAL ONE, TWO
PARAMETER ( ONE = 1.0E0, TWO = 2.0E0 )
* .. Local Scalars .. * .. Local Scalars ..
REAL ALPHA, BETA REAL ALPHA, BETA
* .. Local Arrays .. * .. Local Arrays ..
@ -1834,6 +1879,12 @@
* LERR is set to .TRUE. by the special version of XERBLA each time * LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER. * it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE. LERR = .FALSE.
*
* Initialize ALPHA and BETA.
*
ALPHA = ONE
BETA = TWO
*
GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM
10 INFOT = 1 10 INFOT = 1
CALL SGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL SGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
@ -1963,16 +2014,16 @@
CALL SSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL SSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL SSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL SSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL SSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL SSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 12 INFOT = 12
CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL SSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
@ -2660,7 +2711,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LSERES = .TRUE. LSERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

83
test/zblat1.f
View File

@ -1,7 +1,49 @@
*> \brief \b ZBLAT1
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM ZBLAT1
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX*16 Level 1 BLAS.
*>
*> Based upon the original BLAS test routine together with:
*> F06GAF Example Program Text
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex16_blas_testing
*
* =====================================================================
PROGRAM ZBLAT1 PROGRAM ZBLAT1
* Test program for the COMPLEX*16 Level 1 BLAS. *
* Based upon the original BLAS test routine together with: * -- Reference BLAS test routine (version 3.7.0) --
* F06GAF Example Program Text * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* =====================================================================
*
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) PARAMETER (NOUT=6)
@ -114,8 +156,8 @@
+ (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0), + (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0),
+ (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0), + (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0),
+ (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0), + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+ (7.0D0,8.0D0), (0.3D0,0.1D0), (0.1D0,0.4D0), + (7.0D0,8.0D0), (0.3D0,0.1D0), (0.5D0,0.0D0),
+ (0.4D0,0.1D0), (0.1D0,0.2D0), (2.0D0,3.0D0), + (0.0D0,0.5D0), (0.0D0,0.2D0), (2.0D0,3.0D0),
+ (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/ + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0), DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
+ (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
@ -129,10 +171,10 @@
+ (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0), + (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0),
+ (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0), + (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
+ (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0), + (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0),
+ (0.1D0,0.4D0), (6.0D0,9.0D0), (0.4D0,0.1D0), + (0.5D0,0.0D0), (6.0D0,9.0D0), (0.0D0,0.5D0),
+ (8.0D0,3.0D0), (0.1D0,0.2D0), (9.0D0,4.0D0)/ + (8.0D0,3.0D0), (0.0D0,0.2D0), (9.0D0,4.0D0)/
DATA STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.7D0/ DATA STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.8D0/
DATA STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.7D0/ DATA STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.6D0/
DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0), DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
+ (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+ (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
@ -145,8 +187,8 @@
+ (0.11D0,-0.03D0), (-0.17D0,0.46D0), + (0.11D0,-0.03D0), (-0.17D0,0.46D0),
+ (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0), + (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+ (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0), + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+ (0.19D0,-0.17D0), (0.32D0,0.09D0), + (0.19D0,-0.17D0), (0.20D0,-0.35D0),
+ (0.23D0,-0.24D0), (0.18D0,0.01D0), + (0.35D0,0.20D0), (0.14D0,0.08D0),
+ (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0), + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0),
+ (2.0D0,3.0D0)/ + (2.0D0,3.0D0)/
DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0), DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
@ -162,9 +204,9 @@
+ (-0.17D0,0.46D0), (4.0D0,7.0D0), + (-0.17D0,0.46D0), (4.0D0,7.0D0),
+ (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0), + (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
+ (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0), + (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0),
+ (0.32D0,0.09D0), (6.0D0,9.0D0), + (0.20D0,-0.35D0), (6.0D0,9.0D0),
+ (0.23D0,-0.24D0), (8.0D0,3.0D0), + (0.35D0,0.20D0), (8.0D0,3.0D0),
+ (0.18D0,0.01D0), (9.0D0,4.0D0)/ + (0.14D0,0.08D0), (9.0D0,4.0D0)/
DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0), DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
+ (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
+ (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0), + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
@ -177,8 +219,8 @@
+ (0.03D0,0.03D0), (-0.18D0,0.03D0), + (0.03D0,0.03D0), (-0.18D0,0.03D0),
+ (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0), + (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+ (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0), + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
+ (0.09D0,0.03D0), (0.03D0,0.12D0), + (0.09D0,0.03D0), (0.15D0,0.00D0),
+ (0.12D0,0.03D0), (0.03D0,0.06D0), (2.0D0,3.0D0), + (0.00D0,0.15D0), (0.00D0,0.06D0), (2.0D0,3.0D0),
+ (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/ + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0), DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
+ (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0), + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
@ -193,8 +235,8 @@
+ (-0.18D0,0.03D0), (4.0D0,7.0D0), + (-0.18D0,0.03D0), (4.0D0,7.0D0),
+ (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0), + (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
+ (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0), + (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0),
+ (0.03D0,0.12D0), (6.0D0,9.0D0), (0.12D0,0.03D0), + (0.15D0,0.00D0), (6.0D0,9.0D0), (0.00D0,0.15D0),
+ (8.0D0,3.0D0), (0.03D0,0.06D0), (9.0D0,4.0D0)/ + (8.0D0,3.0D0), (0.00D0,0.06D0), (9.0D0,4.0D0)/
DATA ITRUE3/0, 1, 2, 2, 2/ DATA ITRUE3/0, 1, 2, 2, 2/
* .. Executable Statements .. * .. Executable Statements ..
DO 60 INCX = 1, 2 DO 60 INCX = 1, 2
@ -529,7 +571,8 @@
* *
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) DOUBLE PRECISION ZERO
PARAMETER (NOUT=6, ZERO=0.0D0)
* .. Scalar Arguments .. * .. Scalar Arguments ..
DOUBLE PRECISION SFAC DOUBLE PRECISION SFAC
INTEGER LEN INTEGER LEN
@ -552,7 +595,7 @@
* *
DO 40 I = 1, LEN DO 40 I = 1, LEN
SD = SCOMP(I) - STRUE(I) SD = SCOMP(I) - STRUE(I)
IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
+ GO TO 40 + GO TO 40
* *
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).

188
test/zblat2.f
View File

@ -1,68 +1,114 @@
*> \brief \b ZBLAT2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM ZBLAT2
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX*16 Level 2 Blas.
*>
*> The program must be driven by a short data file. The first 18 records
*> of the file are read using list-directed input, the last 17 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 35 lines:
*> 'zblat2.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'CBLA2T.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 4 NUMBER OF VALUES OF K
*> 0 1 2 4 VALUES OF K
*> 4 NUMBER OF VALUES OF INCX AND INCY
*> 1 2 -1 -2 VALUES OF INCX AND INCY
*> 3 NUMBER OF VALUES OF ALPHA
*> (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
*> ZGEMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZGBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHEMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTRMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTBMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTPMV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTRSV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTBSV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTPSV T PUT F FOR NO TEST. SAME COLUMNS.
*> ZGERC T PUT F FOR NO TEST. SAME COLUMNS.
*> ZGERU T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHER T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHPR T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHER2 T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
*> An extended set of Fortran Basic Linear Algebra Subprograms.
*>
*> Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
*> and Computer Science Division, Argonne National Laboratory,
*> 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> Or
*>
*> NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
*> Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
*> OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
*> Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*>
*>
*> -- Written on 10-August-1987.
*> Richard Hanson, Sandia National Labs.
*> Jeremy Du Croz, NAG Central Office.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex16_blas_testing
*
* =====================================================================
PROGRAM ZBLAT2 PROGRAM ZBLAT2
* *
* Test program for the COMPLEX*16 Level 2 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 18 records * =====================================================================
* of the file are read using list-directed input, the last 17 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 35 lines:
* 'ZBLAT2.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'CBLA2T.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 4 NUMBER OF VALUES OF K
* 0 1 2 4 VALUES OF K
* 4 NUMBER OF VALUES OF INCX AND INCY
* 1 2 -1 -2 VALUES OF INCX AND INCY
* 3 NUMBER OF VALUES OF ALPHA
* (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
* ZGEMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZGBMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZHEMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZHBMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZHPMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZTRMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZTBMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZTPMV T PUT F FOR NO TEST. SAME COLUMNS.
* ZTRSV T PUT F FOR NO TEST. SAME COLUMNS.
* ZTBSV T PUT F FOR NO TEST. SAME COLUMNS.
* ZTPSV T PUT F FOR NO TEST. SAME COLUMNS.
* ZGERC T PUT F FOR NO TEST. SAME COLUMNS.
* ZGERU T PUT F FOR NO TEST. SAME COLUMNS.
* ZHER T PUT F FOR NO TEST. SAME COLUMNS.
* ZHPR T PUT F FOR NO TEST. SAME COLUMNS.
* ZHER2 T PUT F FOR NO TEST. SAME COLUMNS.
* ZHPR2 T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Hammarling S. and Hanson R. J..
* An extended set of Fortran Basic Linear Algebra Subprograms.
*
* Technical Memoranda Nos. 41 (revision 3) and 81, Mathematics
* and Computer Science Division, Argonne National Laboratory,
* 9700 South Cass Avenue, Argonne, Illinois 60439, US.
*
* Or
*
* NAG Technical Reports TR3/87 and TR4/87, Numerical Algorithms
* Group Ltd., NAG Central Office, 256 Banbury Road, Oxford
* OX2 7DE, UK, and Numerical Algorithms Group Inc., 1101 31st
* Street, Suite 100, Downers Grove, Illinois 60515-1263, USA.
*
*
* -- Written on 10-August-1987.
* Richard Hanson, Sandia National Labs.
* Jeremy Du Croz, NAG Central Office.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
@ -72,8 +118,8 @@
COMPLEX*16 ZERO, ONE COMPLEX*16 ZERO, ONE
PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ), PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ),
$ ONE = ( 1.0D0, 0.0D0 ) ) $ ONE = ( 1.0D0, 0.0D0 ) )
DOUBLE PRECISION RZERO, RHALF, RONE DOUBLE PRECISION RZERO
PARAMETER ( RZERO = 0.0D0, RHALF = 0.5D0, RONE = 1.0D0 ) PARAMETER ( RZERO = 0.0D0 )
INTEGER NMAX, INCMAX INTEGER NMAX, INCMAX
PARAMETER ( NMAX = 65, INCMAX = 2 ) PARAMETER ( NMAX = 65, INCMAX = 2 )
INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX INTEGER NINMAX, NIDMAX, NKBMAX, NALMAX, NBEMAX
@ -127,7 +173,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -136,7 +182,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -241,14 +287,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = RONE EPS = EPSILON(RZERO)
90 CONTINUE
IF( DDIFF( RONE + EPS, RONE ).EQ.RZERO )
$ GO TO 100
EPS = RHALF*EPS
GO TO 90
100 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of ZMVCH using exact data. * Check the reliability of ZMVCH using exact data.
@ -3087,7 +3126,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LZERES = .TRUE. LZERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE

191
test/zblat3.f
View File

@ -1,50 +1,97 @@
*> \brief \b ZBLAT3
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM ZBLAT3
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the COMPLEX*16 Level 3 Blas.
*>
*> The program must be driven by a short data file. The first 14 records
*> of the file are read using list-directed input, the last 9 records
*> are read using the format ( A6, L2 ). An annotated example of a data
*> file can be obtained by deleting the first 3 characters from the
*> following 23 lines:
*> 'zblat3.out' NAME OF SUMMARY OUTPUT FILE
*> 6 UNIT NUMBER OF SUMMARY FILE
*> 'ZBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
*> -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
*> F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
*> F LOGICAL FLAG, T TO STOP ON FAILURES.
*> T LOGICAL FLAG, T TO TEST ERROR EXITS.
*> 16.0 THRESHOLD VALUE OF TEST RATIO
*> 6 NUMBER OF VALUES OF N
*> 0 1 2 3 5 9 VALUES OF N
*> 3 NUMBER OF VALUES OF ALPHA
*> (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
*> 3 NUMBER OF VALUES OF BETA
*> (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
*> ZGEMM T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHEMM T PUT F FOR NO TEST. SAME COLUMNS.
*> ZSYMM T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTRMM T PUT F FOR NO TEST. SAME COLUMNS.
*> ZTRSM T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHERK T PUT F FOR NO TEST. SAME COLUMNS.
*> ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
*> ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
*> ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*>
*>
*> Further Details
*> ===============
*>
*> See:
*>
*> Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
*> A Set of Level 3 Basic Linear Algebra Subprograms.
*>
*> Technical Memorandum No.88 (Revision 1), Mathematics and
*> Computer Science Division, Argonne National Laboratory, 9700
*> South Cass Avenue, Argonne, Illinois 60439, US.
*>
*> -- Written on 8-February-1989.
*> Jack Dongarra, Argonne National Laboratory.
*> Iain Duff, AERE Harwell.
*> Jeremy Du Croz, Numerical Algorithms Group Ltd.
*> Sven Hammarling, Numerical Algorithms Group Ltd.
*>
*> 10-9-00: Change STATUS='NEW' to 'UNKNOWN' so that the testers
*> can be run multiple times without deleting generated
*> output files (susan)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex16_blas_testing
*
* =====================================================================
PROGRAM ZBLAT3 PROGRAM ZBLAT3
* *
* Test program for the COMPLEX*16 Level 3 Blas. * -- Reference BLAS test routine (version 3.7.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
* *
* The program must be driven by a short data file. The first 14 records * =====================================================================
* of the file are read using list-directed input, the last 9 records
* are read using the format ( A6, L2 ). An annotated example of a data
* file can be obtained by deleting the first 3 characters from the
* following 23 lines:
* 'ZBLAT3.SUMM' NAME OF SUMMARY OUTPUT FILE
* 6 UNIT NUMBER OF SUMMARY FILE
* 'ZBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE
* -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
* F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
* F LOGICAL FLAG, T TO STOP ON FAILURES.
* T LOGICAL FLAG, T TO TEST ERROR EXITS.
* 16.0 THRESHOLD VALUE OF TEST RATIO
* 6 NUMBER OF VALUES OF N
* 0 1 2 3 5 9 VALUES OF N
* 3 NUMBER OF VALUES OF ALPHA
* (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA
* 3 NUMBER OF VALUES OF BETA
* (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA
* ZGEMM T PUT F FOR NO TEST. SAME COLUMNS.
* ZHEMM T PUT F FOR NO TEST. SAME COLUMNS.
* ZSYMM T PUT F FOR NO TEST. SAME COLUMNS.
* ZTRMM T PUT F FOR NO TEST. SAME COLUMNS.
* ZTRSM T PUT F FOR NO TEST. SAME COLUMNS.
* ZHERK T PUT F FOR NO TEST. SAME COLUMNS.
* ZSYRK T PUT F FOR NO TEST. SAME COLUMNS.
* ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
* ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
*
* See:
*
* Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
* A Set of Level 3 Basic Linear Algebra Subprograms.
*
* Technical Memorandum No.88 (Revision 1), Mathematics and
* Computer Science Division, Argonne National Laboratory, 9700
* South Cass Avenue, Argonne, Illinois 60439, US.
*
* -- Written on 8-February-1989.
* Jack Dongarra, Argonne National Laboratory.
* Iain Duff, AERE Harwell.
* Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* .. Parameters .. * .. Parameters ..
INTEGER NIN INTEGER NIN
@ -54,8 +101,8 @@
COMPLEX*16 ZERO, ONE COMPLEX*16 ZERO, ONE
PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ), PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ),
$ ONE = ( 1.0D0, 0.0D0 ) ) $ ONE = ( 1.0D0, 0.0D0 ) )
DOUBLE PRECISION RZERO, RHALF, RONE DOUBLE PRECISION RZERO
PARAMETER ( RZERO = 0.0D0, RHALF = 0.5D0, RONE = 1.0D0 ) PARAMETER ( RZERO = 0.0D0 )
INTEGER NMAX INTEGER NMAX
PARAMETER ( NMAX = 65 ) PARAMETER ( NMAX = 65 )
INTEGER NIDMAX, NALMAX, NBEMAX INTEGER NIDMAX, NALMAX, NBEMAX
@ -104,7 +151,7 @@
* *
READ( NIN, FMT = * )SUMMRY READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT READ( NIN, FMT = * )NOUT
OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' ) OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
NOUTC = NOUT NOUTC = NOUT
* *
* Read name and unit number for snapshot output file and open file. * Read name and unit number for snapshot output file and open file.
@ -113,7 +160,7 @@
READ( NIN, FMT = * )NTRA READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0 TRACE = NTRA.GE.0
IF( TRACE )THEN IF( TRACE )THEN
OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' ) OPEN( NTRA, FILE = SNAPS, STATUS = 'UNKNOWN' )
END IF END IF
* Read the flag that directs rewinding of the snapshot file. * Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI READ( NIN, FMT = * )REWI
@ -190,14 +237,7 @@
* *
* Compute EPS (the machine precision). * Compute EPS (the machine precision).
* *
EPS = RONE EPS = EPSILON(RZERO)
70 CONTINUE
IF( DDIFF( RONE + EPS, RONE ).EQ.RZERO )
$ GO TO 80
EPS = RHALF*EPS
GO TO 70
80 CONTINUE
EPS = EPS + EPS
WRITE( NOUT, FMT = 9998 )EPS WRITE( NOUT, FMT = 9998 )EPS
* *
* Check the reliability of ZMMCH using exact data. * Check the reliability of ZMMCH using exact data.
@ -1303,8 +1343,6 @@
NC = 0 NC = 0
RESET = .TRUE. RESET = .TRUE.
ERRMAX = RZERO ERRMAX = RZERO
RALS = RONE
RBETS = RONE
* *
DO 100 IN = 1, NIDIM DO 100 IN = 1, NIDIM
N = IDIM( IN ) N = IDIM( IN )
@ -1951,7 +1989,7 @@
* *
* Tests the error exits from the Level 3 Blas. * Tests the error exits from the Level 3 Blas.
* Requires a special version of the error-handling routine XERBLA. * Requires a special version of the error-handling routine XERBLA.
* ALPHA, RALPHA, BETA, RBETA, A, B and C should not need to be defined. * A, B and C should not need to be defined.
* *
* Auxiliary routine for test program for Level 3 Blas. * Auxiliary routine for test program for Level 3 Blas.
* *
@ -1961,12 +1999,20 @@
* Jeremy Du Croz, Numerical Algorithms Group Ltd. * Jeremy Du Croz, Numerical Algorithms Group Ltd.
* Sven Hammarling, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd.
* *
* 3-19-92: Initialize ALPHA, BETA, RALPHA, and RBETA (eca)
* 3-19-92: Fix argument 12 in calls to ZSYMM and ZHEMM
* with INFOT = 9 (eca)
* 10-9-00: Declared INTRINSIC DCMPLX (susan)
*
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER ISNUM, NOUT INTEGER ISNUM, NOUT
CHARACTER*6 SRNAMT CHARACTER*6 SRNAMT
* .. Scalars in Common .. * .. Scalars in Common ..
INTEGER INFOT, NOUTC INTEGER INFOT, NOUTC
LOGICAL LERR, OK LOGICAL LERR, OK
* .. Parameters ..
REAL ONE, TWO
PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 )
* .. Local Scalars .. * .. Local Scalars ..
COMPLEX*16 ALPHA, BETA COMPLEX*16 ALPHA, BETA
DOUBLE PRECISION RALPHA, RBETA DOUBLE PRECISION RALPHA, RBETA
@ -1975,6 +2021,8 @@
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM, EXTERNAL ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
$ ZSYR2K, ZSYRK, ZTRMM, ZTRSM $ ZSYR2K, ZSYRK, ZTRMM, ZTRSM
* .. Intrinsic Functions ..
INTRINSIC DCMPLX
* .. Common blocks .. * .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Executable Statements .. * .. Executable Statements ..
@ -1984,6 +2032,14 @@
* LERR is set to .TRUE. by the special version of XERBLA each time * LERR is set to .TRUE. by the special version of XERBLA each time
* it is called, and is then tested and re-set by CHKXER. * it is called, and is then tested and re-set by CHKXER.
LERR = .FALSE. LERR = .FALSE.
*
* Initialize ALPHA, BETA, RALPHA, and RBETA.
*
ALPHA = DCMPLX( ONE, -ONE )
BETA = DCMPLX( TWO, -TWO )
RALPHA = ONE
RBETA = TWO
*
GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
$ 90 )ISNUM $ 90 )ISNUM
10 INFOT = 1 10 INFOT = 1
@ -2210,16 +2266,16 @@
CALL ZHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL ZHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL ZHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 12 INFOT = 12
CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
@ -2277,16 +2333,16 @@
CALL ZSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL ZSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL ZSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 9 INFOT = 9
CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
INFOT = 12 INFOT = 12
CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
@ -3276,7 +3332,6 @@
50 CONTINUE 50 CONTINUE
END IF END IF
* *
60 CONTINUE
LZERES = .TRUE. LZERES = .TRUE.
GO TO 80 GO TO 80
70 CONTINUE 70 CONTINUE