Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
*> \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
*
* =====================================================================
* -- Reference BLAS test routine (version 3.4.1) --
* -- 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 ..
INTEGER NIN
PARAMETER ( NIN = 5 )
INTEGER NSUBS
PARAMETER ( NSUBS = 6 )
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
INTEGER NMAX
PARAMETER ( NMAX = 65 )
INTEGER NIDMAX, NALMAX, NBEMAX
PARAMETER ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
* .. Local Scalars ..
REAL EPS, ERR, THRESH
INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
$ TSTERR
CHARACTER*1 TRANSA, TRANSB
CHARACTER*6 SNAMET
CHARACTER*32 SNAPS, SUMMRY
* .. Local Arrays ..
REAL AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
$ ALF( NALMAX ), AS( NMAX*NMAX ),
$ BB( NMAX*NMAX ), BET( NBEMAX ),
$ BS( NMAX*NMAX ), C( NMAX, NMAX ),
$ CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
$ G( NMAX ), W( 2*NMAX )
INTEGER IDIM( NIDMAX )
LOGICAL LTEST( NSUBS )
CHARACTER*6 SNAMES( NSUBS )
* .. External Functions ..
REAL SDIFF
LOGICAL LSE
EXTERNAL SDIFF, LSE
* .. External Subroutines ..
EXTERNAL SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, SCHKE, SMMCH
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL LERR, OK
CHARACTER*6 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Data statements ..
DATA SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ',
$ 'SSYRK ', 'SSYR2K'/
* .. Executable Statements ..
*
* Read name and unit number for summary output file and open file.
*
READ( NIN, FMT = * )SUMMRY
READ( NIN, FMT = * )NOUT
NOUTC = NOUT
*
* Read name and unit number for snapshot output file and open file.
*
READ( NIN, FMT = * )SNAPS
READ( NIN, FMT = * )NTRA
TRACE = NTRA.GE.0
IF( TRACE )THEN
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
END IF
* Read the flag that directs rewinding of the snapshot file.
READ( NIN, FMT = * )REWI
REWI = REWI.AND.TRACE
* Read the flag that directs stopping on any failure.
READ( NIN, FMT = * )SFATAL
* Read the flag that indicates whether error exits are to be tested.
READ( NIN, FMT = * )TSTERR
* Read the threshold value of the test ratio
READ( NIN, FMT = * )THRESH
*
* Read and check the parameter values for the tests.
*
* Values of N
READ( NIN, FMT = * )NIDIM
IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
WRITE( NOUT, FMT = 9997 )'N', NIDMAX
GO TO 220
END IF
READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
DO 10 I = 1, NIDIM
IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
WRITE( NOUT, FMT = 9996 )NMAX
GO TO 220
END IF
10 CONTINUE
* Values of ALPHA
READ( NIN, FMT = * )NALF
IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
GO TO 220
END IF
READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
* Values of BETA
READ( NIN, FMT = * )NBET
IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
GO TO 220
END IF
READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
*
* Report values of parameters.
*
WRITE( NOUT, FMT = 9995 )
WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
Loading full blame...