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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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
145
146
147
148
149
150
151
152
153
154
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
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
|
SUBROUTINE DTIMMV( VNAME, NN, NVAL, NK, KVAL, NLDA, LDAVAL,
$ TIMMIN, A, LB, B, C, RESLTS, LDR1, LDR2, NOUT )
*
* -- LAPACK timing routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* March 31, 1993
*
* .. Scalar Arguments ..
CHARACTER*( * ) VNAME
INTEGER LB, LDR1, LDR2, NK, NLDA, NN, NOUT
DOUBLE PRECISION TIMMIN
* ..
* .. Array Arguments ..
INTEGER KVAL( * ), LDAVAL( * ), NVAL( * )
DOUBLE PRECISION A( * ), B( * ), C( * ), RESLTS( LDR1, LDR2, * )
* ..
*
* Purpose
* =======
*
* DTIMMV times individual BLAS 2 routines.
*
* Arguments
* =========
*
* VNAME (input) CHARACTER*(*)
* The name of the Level 2 BLAS routine to be timed.
*
* NN (input) INTEGER
* The number of values of N contained in the vector NVAL.
*
* NVAL (input) INTEGER array, dimension (NN)
* The values of the matrix dimension N.
*
* NK (input) INTEGER
* The number of values of K contained in the vector KVAL.
*
* KVAL (input) INTEGER array, dimension (NK)
* The values of the bandwidth K.
*
* NLDA (input) INTEGER
* The number of values of LDA contained in the vector LDAVAL.
*
* LDAVAL (input) INTEGER array, dimension (NLDA)
* The values of the leading dimension of the array A.
*
* TIMMIN (input) DOUBLE PRECISION
* The minimum time a subroutine will be timed.
*
* A (workspace) DOUBLE PRECISION array, dimension (LDAMAX*NMAX)
* where LDAMAX and NMAX are the maximum values permitted
* for LDA and N.
*
* LB (input) INTEGER
* The length of B and C, needed when timing DGBMV. If timing
* DGEMV, LB >= LDAMAX*NMAX.
*
* B (workspace) DOUBLE PRECISION array, dimension (LB)
*
* C (workspace) DOUBLE PRECISION array, dimension (LB)
*
* RESLTS (output) DOUBLE PRECISION array, dimension (LDR1,LDR2,NLDA)
* The timing results for each subroutine over the relevant
* values of N and LDA.
*
* LDR1 (input) INTEGER
* The first dimension of RESLTS. LDR1 >= max(1,NK).
*
* LDR2 (input) INTEGER
* The second dimension of RESLTS. LDR2 >= max(1,NN).
*
* NOUT (input) INTEGER
* The unit number for output.
*
* =====================================================================
*
* .. Parameters ..
INTEGER NSUBS
DOUBLE PRECISION ONE
PARAMETER ( NSUBS = 2, ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
CHARACTER LAB1, LAB2
CHARACTER*6 CNAME
INTEGER I, IB, IC, ICL, IK, ILDA, IN, INFO, ISUB, K,
$ KL, KU, LDA, LDB, N, NRHS
DOUBLE PRECISION OPS, S1, S2, TIME, UNTIME
* ..
* .. Local Arrays ..
LOGICAL TIMSUB( NSUBS )
CHARACTER*6 SUBNAM( NSUBS )
* ..
* .. External Functions ..
LOGICAL LSAME, LSAMEN
DOUBLE PRECISION DMFLOP, DOPBL2, DSECND
EXTERNAL LSAME, LSAMEN, DMFLOP, DOPBL2, DSECND
* ..
* .. External Subroutines ..
EXTERNAL ATIMCK, DGBMV, DGEMV, DPRTBL, DTIMMG
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, MAX, MIN
* ..
* .. Data statements ..
DATA SUBNAM / 'DGEMV ', 'DGBMV ' /
* ..
* .. Executable Statements ..
*
CNAME = VNAME
DO 10 ISUB = 1, NSUBS
TIMSUB( ISUB ) = LSAMEN( 6, CNAME, SUBNAM( ISUB ) )
IF( TIMSUB( ISUB ) )
$ GO TO 20
10 CONTINUE
WRITE( NOUT, FMT = 9999 )CNAME
GO TO 150
20 CONTINUE
*
* Check that N or K <= LDA for the input values.
*
IF( LSAME( CNAME( 3: 3 ), 'B' ) ) THEN
CALL ATIMCK( 0, CNAME, NK, KVAL, NLDA, LDAVAL, NOUT, INFO )
LAB1 = 'M'
LAB2 = 'K'
ELSE
CALL ATIMCK( 2, CNAME, NN, NVAL, NLDA, LDAVAL, NOUT, INFO )
LAB1 = ' '
LAB2 = 'N'
END IF
IF( INFO.GT.0 ) THEN
WRITE( NOUT, FMT = 9998 )CNAME
GO TO 150
END IF
*
* Print the table header on unit NOUT.
*
WRITE( NOUT, FMT = 9997 )VNAME
IF( NLDA.EQ.1 ) THEN
WRITE( NOUT, FMT = 9996 )LDAVAL( 1 )
ELSE
DO 30 I = 1, NLDA
WRITE( NOUT, FMT = 9995 )I, LDAVAL( I )
30 CONTINUE
END IF
WRITE( NOUT, FMT = * )
*
* Time DGEMV
*
IF( TIMSUB( 1 ) ) THEN
DO 80 ILDA = 1, NLDA
LDA = LDAVAL( ILDA )
DO 70 IN = 1, NN
N = NVAL( IN )
NRHS = N
LDB = LDA
CALL DTIMMG( 1, N, N, A, LDA, 0, 0 )
CALL DTIMMG( 0, N, NRHS, B, LDB, 0, 0 )
CALL DTIMMG( 1, N, NRHS, C, LDB, 0, 0 )
IC = 0
S1 = DSECND( )
40 CONTINUE
IB = 1
DO 50 I = 1, NRHS
CALL DGEMV( 'No transpose', N, N, ONE, A, LDA,
$ B( IB ), 1, ONE, C( IB ), 1 )
IB = IB + LDB
50 CONTINUE
S2 = DSECND( )
TIME = S2 - S1
IC = IC + 1
IF( TIME.LT.TIMMIN ) THEN
CALL DTIMMG( 1, N, NRHS, C, LDB, 0, 0 )
GO TO 40
END IF
*
* Subtract the time used in DTIMMG.
*
ICL = 1
S1 = DSECND( )
60 CONTINUE
S2 = DSECND( )
UNTIME = S2 - S1
ICL = ICL + 1
IF( ICL.LE.IC ) THEN
CALL DTIMMG( 1, N, NRHS, C, LDB, 0, 0 )
GO TO 60
END IF
*
TIME = ( TIME-UNTIME ) / DBLE( IC )
OPS = NRHS*DOPBL2( 'DGEMV ', N, N, 0, 0 )
RESLTS( 1, IN, ILDA ) = DMFLOP( OPS, TIME, 0 )
70 CONTINUE
80 CONTINUE
*
CALL DPRTBL( LAB1, LAB2, 1, NVAL, NN, NVAL, NLDA, RESLTS, LDR1,
$ LDR2, NOUT )
*
ELSE IF( TIMSUB( 2 ) ) THEN
*
* Time DGBMV
*
DO 140 ILDA = 1, NLDA
LDA = LDAVAL( ILDA )
DO 130 IN = 1, NN
N = NVAL( IN )
DO 120 IK = 1, NK
K = MIN( N-1, MAX( 0, KVAL( IK ) ) )
KL = K
KU = K
LDB = N
CALL DTIMMG( 2, N, N, A, LDA, KL, KU )
NRHS = MIN( K, LB / LDB )
CALL DTIMMG( 0, N, NRHS, B, LDB, 0, 0 )
CALL DTIMMG( 1, N, NRHS, C, LDB, 0, 0 )
IC = 0
S1 = DSECND( )
90 CONTINUE
IB = 1
DO 100 I = 1, NRHS
CALL DGBMV( 'No transpose', N, N, KL, KU, ONE,
$ A( KU+1 ), LDA, B( IB ), 1, ONE,
$ C( IB ), 1 )
IB = IB + LDB
100 CONTINUE
S2 = DSECND( )
TIME = S2 - S1
IC = IC + 1
IF( TIME.LT.TIMMIN ) THEN
CALL DTIMMG( 1, N, NRHS, C, LDB, 0, 0 )
GO TO 90
END IF
*
* Subtract the time used in DTIMMG.
*
ICL = 1
S1 = DSECND( )
110 CONTINUE
S2 = DSECND( )
UNTIME = S2 - S1
ICL = ICL + 1
IF( ICL.LE.IC ) THEN
CALL DTIMMG( 1, N, NRHS, C, LDB, 0, 0 )
GO TO 110
END IF
*
TIME = ( TIME-UNTIME ) / DBLE( IC )
OPS = NRHS*DOPBL2( 'DGBMV ', N, N, KL, KU )
RESLTS( IN, IK, ILDA ) = DMFLOP( OPS, TIME, 0 )
120 CONTINUE
130 CONTINUE
140 CONTINUE
*
CALL DPRTBL( LAB1, LAB2, NN, NVAL, NK, KVAL, NLDA, RESLTS,
$ LDR1, LDR2, NOUT )
END IF
*
150 CONTINUE
9999 FORMAT( 1X, A6, ': Unrecognized path or subroutine name', / )
9998 FORMAT( 1X, A6, ' timing run not attempted', / )
9997 FORMAT( / ' *** Speed of ', A6, ' in megaflops ***' )
9996 FORMAT( 5X, 'with LDA = ', I5 )
9995 FORMAT( 5X, 'line ', I2, ' with LDA = ', I5 )
RETURN
*
* End of DTIMMV
*
END
|
