1      SUBROUTINE STIMHR( LINE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
2     $                   NLDA, LDAVAL, TIMMIN, A, TAU, B, WORK, RESLTS,
3     $                   LDR1, LDR2, LDR3, NOUT )
4*
5*  -- LAPACK timing routine (version 3.0) --
6*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
7*     Courant Institute, Argonne National Lab, and Rice University
8*     March 31, 1993
9*
10*     .. Scalar Arguments ..
11      CHARACTER*80       LINE
12      INTEGER            LDR1, LDR2, LDR3, NLDA, NM, NN, NNB, NOUT
13      REAL               TIMMIN
14*     ..
15*     .. Array Arguments ..
16      INTEGER            LDAVAL( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
17     $                   NXVAL( * )
18      REAL               A( * ), B( * ), RESLTS( LDR1, LDR2, LDR3, * ),
19     $                   TAU( * ), WORK( * )
20*     ..
21*
22*  Purpose
23*  =======
24*
25*  STIMHR times the LAPACK routines SGEHRD, SORGHR, and SORMHR and the
26*  EISPACK routine ORTHES.
27*
28*  Arguments
29*  =========
30*
31*  LINE    (input) CHARACTER*80
32*          The input line that requested this routine.  The first six
33*          characters contain either the name of a subroutine or a
34*          generic path name.  The remaining characters may be used to
35*          specify the individual routines to be timed.  See ATIMIN for
36*          a full description of the format of the input line.
37*
38*  NM      (input) INTEGER
39*          The number of values of M contained in the vector MVAL.
40*
41*  MVAL    (input) INTEGER array, dimension (NM)
42*          The values of the matrix size M.
43*
44*  NN      (input) INTEGER
45*          The number of values of N contained in the vector NVAL.
46*
47*  NVAL    (input) INTEGER array, dimension (NN)
48*          The values of the matrix column dimension N.
49*
50*  NNB     (input) INTEGER
51*          The number of values of NB and NX contained in the
52*          vectors NBVAL and NXVAL.  The blocking parameters are used
53*          in pairs (NB,NX).
54*
55*  NBVAL   (input) INTEGER array, dimension (NNB)
56*          The values of the blocksize NB.
57*
58*  NXVAL   (input) INTEGER array, dimension (NNB)
59*          The values of the crossover point NX.
60*
61*  NLDA    (input) INTEGER
62*          The number of values of LDA contained in the vector LDAVAL.
63*
64*  LDAVAL  (input) INTEGER array, dimension (NLDA)
65*          The values of the leading dimension of the array A.
66*
67*  TIMMIN  (input) REAL
68*          The minimum time a subroutine will be timed.
69*
70*  A       (workspace) REAL array, dimension (LDAMAX*NMAX)
71*          where LDAMAX and NMAX are the maximum values of LDA and N.
72*
73*  TAU     (workspace) REAL array, dimension (min(M,N))
74*
75*  B       (workspace) REAL array, dimension (LDAMAX*NMAX)
76*
77*  WORK    (workspace) REAL array, dimension (LDAMAX*NBMAX)
78*          where NBMAX is the maximum value of NB.
79*
80*  RESLTS  (workspace) REAL array, dimension
81*                      (LDR1,LDR2,LDR3,4*NN+3)
82*          The timing results for each subroutine over the relevant
83*          values of M, (NB,NX), LDA, and N.
84*
85*  LDR1    (input) INTEGER
86*          The first dimension of RESLTS.  LDR1 >= max(1,NNB).
87*
88*  LDR2    (input) INTEGER
89*          The second dimension of RESLTS.  LDR2 >= max(1,NM).
90*
91*  LDR3    (input) INTEGER
92*          The third dimension of RESLTS.  LDR3 >= max(1,NLDA).
93*
94*  NOUT    (input) INTEGER
95*          The unit number for output.
96*
97*  Internal Parameters
98*  ===================
99*
100*  MODE    INTEGER
101*          The matrix type.  MODE = 3 is a geometric distribution of
102*          eigenvalues.  See CLATMS for further details.
103*
104*  COND    REAL
105*          The condition number of the matrix.  The singular values are
106*          set to values from DMAX to DMAX/COND.
107*
108*  DMAX    REAL
109*          The magnitude of the largest singular value.
110*
111*  =====================================================================
112*
113*     .. Parameters ..
114      INTEGER            NSUBS
115      PARAMETER          ( NSUBS = 4 )
116      INTEGER            MODE
117      REAL               COND, DMAX
118      PARAMETER          ( MODE = 3, COND = 100.0E0, DMAX = 1.0E0 )
119*     ..
120*     .. Local Scalars ..
121      CHARACTER          LAB1, LAB2, SIDE, TRANS
122      CHARACTER*3        PATH
123      CHARACTER*6        CNAME
124      INTEGER            I, I4, IC, ICL, IHI, ILDA, ILO, IM, IN, INB,
125     $                   INFO, ISIDE, ISUB, ITOFF, ITRAN, LDA, LW, M,
126     $                   M1, N, N1, NB, NX
127      REAL               OPS, S1, S2, TIME, UNTIME
128*     ..
129*     .. Local Arrays ..
130      LOGICAL            TIMSUB( NSUBS )
131      CHARACTER          SIDES( 2 ), TRANSS( 2 )
132      CHARACTER*6        SUBNAM( NSUBS )
133      INTEGER            ISEED( 4 ), RESEED( 4 )
134*     ..
135*     .. External Functions ..
136      REAL               SECOND, SMFLOP, SOPLA
137      EXTERNAL           SECOND, SMFLOP, SOPLA
138*     ..
139*     .. External Subroutines ..
140      EXTERNAL           ATIMCK, ATIMIN, ICOPY, ORTHES, SGEHRD, SLACPY,
141     $                   SLATMS, SORGHR, SORMHR, SPRTB3, SPRTBL, STIMMG,
142     $                   XLAENV
143*     ..
144*     .. Intrinsic Functions ..
145      INTRINSIC          MAX, REAL
146*     ..
147*     .. Data statements ..
148      DATA               SUBNAM / 'SGEHRD', 'ORTHES', 'SORGHR',
149     $                   'SORMHR' /
150      DATA               SIDES / 'L', 'R' / , TRANSS / 'N', 'T' /
151      DATA               ISEED / 0, 0, 0, 1 /
152*     ..
153*     .. Executable Statements ..
154*
155*     Extract the timing request from the input line.
156*
157      PATH( 1: 1 ) = 'Single precision'
158      PATH( 2: 3 ) = 'HR'
159      CALL ATIMIN( PATH, LINE, NSUBS, SUBNAM, TIMSUB, NOUT, INFO )
160      IF( INFO.NE.0 )
161     $   GO TO 210
162*
163*     Check that N <= LDA for the input values.
164*
165      CNAME = LINE( 1: 6 )
166      CALL ATIMCK( 2, CNAME, NM, MVAL, NLDA, LDAVAL, NOUT, INFO )
167      IF( INFO.GT.0 ) THEN
168         WRITE( NOUT, FMT = 9999 )CNAME
169         GO TO 210
170      END IF
171*
172*     Check that K <= LDA for SORMHR
173*
174      IF( TIMSUB( 4 ) ) THEN
175         CALL ATIMCK( 3, CNAME, NN, NVAL, NLDA, LDAVAL, NOUT, INFO )
176         IF( INFO.GT.0 ) THEN
177            WRITE( NOUT, FMT = 9999 )SUBNAM( 4 )
178            TIMSUB( 4 ) = .FALSE.
179         END IF
180      END IF
181*
182*     Do for each value of M:
183*
184      DO 140 IM = 1, NM
185         M = MVAL( IM )
186         ILO = 1
187         IHI = M
188         CALL ICOPY( 4, ISEED, 1, RESEED, 1 )
189*
190*        Do for each value of LDA:
191*
192         DO 130 ILDA = 1, NLDA
193            LDA = LDAVAL( ILDA )
194*
195*           Do for each pair of values (NB, NX) in NBVAL and NXVAL.
196*
197            DO 120 INB = 1, NNB
198               NB = NBVAL( INB )
199               CALL XLAENV( 1, NB )
200               NX = NXVAL( INB )
201               CALL XLAENV( 3, NX )
202               LW = MAX( 1, M*MAX( 1, NB ) )
203*
204*              Generate a test matrix of size M by M.
205*
206               CALL ICOPY( 4, RESEED, 1, ISEED, 1 )
207               CALL SLATMS( M, M, 'Uniform', ISEED, 'Nonsym', TAU, MODE,
208     $                      COND, DMAX, M, M, 'No packing', B, LDA,
209     $                      WORK, INFO )
210*
211               IF( TIMSUB( 2 ) .AND. INB.EQ.1 ) THEN
212*
213*                 ORTHES:  Eispack reduction using orthogonal
214*                 transformations.
215*
216                  CALL SLACPY( 'Full', M, M, B, LDA, A, LDA )
217                  IC = 0
218                  S1 = SECOND( )
219   10             CONTINUE
220                  CALL ORTHES( LDA, M, 1, IHI, A, TAU )
221                  S2 = SECOND( )
222                  TIME = S2 - S1
223                  IC = IC + 1
224                  IF( TIME.LT.TIMMIN ) THEN
225                     CALL SLACPY( 'Full', M, M, B, LDA, A, LDA )
226                     GO TO 10
227                  END IF
228*
229*                 Subtract the time used in SLACPY.
230*
231                  ICL = 1
232                  S1 = SECOND( )
233   20             CONTINUE
234                  S2 = SECOND( )
235                  UNTIME = S2 - S1
236                  ICL = ICL + 1
237                  IF( ICL.LE.IC ) THEN
238                     CALL SLACPY( 'Full', M, M, B, LDA, A, LDA )
239                     GO TO 20
240                  END IF
241*
242                  TIME = ( TIME-UNTIME ) / REAL( IC )
243                  OPS = SOPLA( 'SGEHRD', M, ILO, IHI, 0, NB )
244                  RESLTS( INB, IM, ILDA, 2 ) = SMFLOP( OPS, TIME, INFO )
245               END IF
246*
247               IF( TIMSUB( 1 ) ) THEN
248*
249*                 SGEHRD:  Reduction to Hesenberg form
250*
251                  CALL SLACPY( 'Full', M, M, B, LDA, A, LDA )
252                  IC = 0
253                  S1 = SECOND( )
254   30             CONTINUE
255                  CALL SGEHRD( M, ILO, IHI, A, LDA, TAU, WORK, LW,
256     $                         INFO )
257                  S2 = SECOND( )
258                  TIME = S2 - S1
259                  IC = IC + 1
260                  IF( TIME.LT.TIMMIN ) THEN
261                     CALL SLACPY( 'Full', M, M, B, LDA, A, LDA )
262                     GO TO 30
263                  END IF
264*
265*                 Subtract the time used in SLACPY.
266*
267                  ICL = 1
268                  S1 = SECOND( )
269   40             CONTINUE
270                  S2 = SECOND( )
271                  UNTIME = S2 - S1
272                  ICL = ICL + 1
273                  IF( ICL.LE.IC ) THEN
274                     CALL SLACPY( 'Full', M, M, A, LDA, B, LDA )
275                     GO TO 40
276                  END IF
277*
278                  TIME = ( TIME-UNTIME ) / REAL( IC )
279                  OPS = SOPLA( 'SGEHRD', M, ILO, IHI, 0, NB )
280                  RESLTS( INB, IM, ILDA, 1 ) = SMFLOP( OPS, TIME, INFO )
281               ELSE
282*
283*                 If SGEHRD was not timed, generate a matrix and factor
284*                 it using SGEHRD anyway so that the factored form of
285*                 the matrix can be used in timing the other routines.
286*
287                  CALL SLACPY( 'Full', M, M, B, LDA, A, LDA )
288                  CALL SGEHRD( M, ILO, IHI, A, LDA, TAU, WORK, LW,
289     $                         INFO )
290               END IF
291*
292               IF( TIMSUB( 3 ) ) THEN
293*
294*                 SORGHR:  Generate the orthogonal matrix Q from the
295*                 reduction to Hessenberg form A = Q*H*Q'
296*
297                  CALL SLACPY( 'Full', M, M, A, LDA, B, LDA )
298                  IC = 0
299                  S1 = SECOND( )
300   50             CONTINUE
301                  CALL SORGHR( M, ILO, IHI, B, LDA, TAU, WORK, LW,
302     $                         INFO )
303                  S2 = SECOND( )
304                  TIME = S2 - S1
305                  IC = IC + 1
306                  IF( TIME.LT.TIMMIN ) THEN
307                     CALL SLACPY( 'Full', M, M, A, LDA, B, LDA )
308                     GO TO 50
309                  END IF
310*
311*                 Subtract the time used in SLACPY.
312*
313                  ICL = 1
314                  S1 = SECOND( )
315   60             CONTINUE
316                  S2 = SECOND( )
317                  UNTIME = S2 - S1
318                  ICL = ICL + 1
319                  IF( ICL.LE.IC ) THEN
320                     CALL SLACPY( 'Full', M, M, A, LDA, B, LDA )
321                     GO TO 60
322                  END IF
323*
324                  TIME = ( TIME-UNTIME ) / REAL( IC )
325*
326*                 Op count for SORGHR:  same as
327*                    SORGQR( IHI-ILO, IHI-ILO, IHI-ILO, ... )
328*
329                  OPS = SOPLA( 'SORGQR', IHI-ILO, IHI-ILO, IHI-ILO, 0,
330     $                  NB )
331                  RESLTS( INB, IM, ILDA, 3 ) = SMFLOP( OPS, TIME, INFO )
332               END IF
333*
334               IF( TIMSUB( 4 ) ) THEN
335*
336*                 SORMHR:  Multiply by Q stored as a product of
337*                 elementary transformations
338*
339                  I4 = 3
340                  DO 110 ISIDE = 1, 2
341                     SIDE = SIDES( ISIDE )
342                     DO 100 IN = 1, NN
343                        N = NVAL( IN )
344                        LW = MAX( 1, MAX( 1, NB )*N )
345                        IF( ISIDE.EQ.1 ) THEN
346                           M1 = M
347                           N1 = N
348                        ELSE
349                           M1 = N
350                           N1 = M
351                        END IF
352                        ITOFF = 0
353                        DO 90 ITRAN = 1, 2
354                           TRANS = TRANSS( ITRAN )
355                           CALL STIMMG( 0, M1, N1, B, LDA, 0, 0 )
356                           IC = 0
357                           S1 = SECOND( )
358   70                      CONTINUE
359                           CALL SORMHR( SIDE, TRANS, M1, N1, ILO, IHI,
360     $                                  A, LDA, TAU, B, LDA, WORK, LW,
361     $                                  INFO )
362                           S2 = SECOND( )
363                           TIME = S2 - S1
364                           IC = IC + 1
365                           IF( TIME.LT.TIMMIN ) THEN
366                              CALL STIMMG( 0, M1, N1, B, LDA, 0, 0 )
367                              GO TO 70
368                           END IF
369*
370*                          Subtract the time used in STIMMG.
371*
372                           ICL = 1
373                           S1 = SECOND( )
374   80                      CONTINUE
375                           S2 = SECOND( )
376                           UNTIME = S2 - S1
377                           ICL = ICL + 1
378                           IF( ICL.LE.IC ) THEN
379                              CALL STIMMG( 0, M1, N1, B, LDA, 0, 0 )
380                              GO TO 80
381                           END IF
382*
383                           TIME = ( TIME-UNTIME ) / REAL( IC )
384*
385*                          Op count for SORMHR, SIDE='L':  same as
386*                          SORMQR( 'L', TRANS, IHI-ILO, N, IHI-ILO, ...)
387*
388*                          Op count for SORMHR, SIDE='R':  same as
389*                          SORMQR( 'R', TRANS, M, IHI-ILO, IHI-ILO, ...)
390*
391                           IF( ISIDE.EQ.1 ) THEN
392                              OPS = SOPLA( 'SORMQR', IHI-ILO, N1,
393     $                              IHI-ILO, -1, NB )
394                           ELSE
395                              OPS = SOPLA( 'SORMQR', M1, IHI-ILO,
396     $                              IHI-ILO, 1, NB )
397                           END IF
398*
399                           RESLTS( INB, IM, ILDA,
400     $                        I4+ITOFF+IN ) = SMFLOP( OPS, TIME, INFO )
401                           ITOFF = NN
402   90                   CONTINUE
403  100                CONTINUE
404                     I4 = I4 + 2*NN
405  110             CONTINUE
406               END IF
407*
408  120       CONTINUE
409  130    CONTINUE
410  140 CONTINUE
411*
412*     Print tables of results for SGEHRD, ORTHES, and SORGHR
413*
414      DO 160 ISUB = 1, NSUBS - 1
415         IF( .NOT.TIMSUB( ISUB ) )
416     $      GO TO 160
417         WRITE( NOUT, FMT = 9998 )SUBNAM( ISUB )
418         IF( NLDA.GT.1 ) THEN
419            DO 150 I = 1, NLDA
420               WRITE( NOUT, FMT = 9997 )I, LDAVAL( I )
421  150       CONTINUE
422         END IF
423         WRITE( NOUT, FMT = 9995 )
424         IF( ISUB.EQ.2 ) THEN
425            CALL SPRTB3( ' ', 'N', 1, NBVAL, NXVAL, NM, MVAL, NLDA,
426     $                   RESLTS( 1, 1, 1, ISUB ), LDR1, LDR2, NOUT )
427         ELSE
428            CALL SPRTB3( '(  NB,  NX)', 'N', NNB, NBVAL, NXVAL, NM,
429     $                   MVAL, NLDA, RESLTS( 1, 1, 1, ISUB ), LDR1,
430     $                   LDR2, NOUT )
431         END IF
432  160 CONTINUE
433*
434*     Print tables of results for SORMHR
435*
436      ISUB = 4
437      IF( TIMSUB( ISUB ) ) THEN
438         I4 = 3
439         DO 200 ISIDE = 1, 2
440            IF( ISIDE.EQ.1 ) THEN
441               LAB1 = 'M'
442               LAB2 = 'N'
443               IF( NLDA.GT.1 ) THEN
444                  WRITE( NOUT, FMT = 9998 )SUBNAM( ISUB )
445                  DO 170 I = 1, NLDA
446                     WRITE( NOUT, FMT = 9997 )I, LDAVAL( I )
447  170             CONTINUE
448                  WRITE( NOUT, FMT = 9994 )
449               END IF
450            ELSE
451               LAB1 = 'N'
452               LAB2 = 'M'
453            END IF
454            DO 190 ITRAN = 1, 2
455               DO 180 IN = 1, NN
456                  WRITE( NOUT, FMT = 9996 )SUBNAM( ISUB ),
457     $               SIDES( ISIDE ), TRANSS( ITRAN ), LAB2, NVAL( IN )
458                  CALL SPRTBL( 'NB', LAB1, NNB, NBVAL, NM, MVAL, NLDA,
459     $                         RESLTS( 1, 1, 1, I4+IN ), LDR1, LDR2,
460     $                         NOUT )
461  180          CONTINUE
462               I4 = I4 + NN
463  190       CONTINUE
464  200    CONTINUE
465      END IF
466  210 CONTINUE
467*
468*     Print a table of results for each timed routine.
469*
470 9999 FORMAT( 1X, A6, ' timing run not attempted', / )
471 9998 FORMAT( / ' *** Speed of ', A6, ' in megaflops *** ' )
472 9997 FORMAT( 5X, 'line ', I2, ' with LDA = ', I5 )
473 9996 FORMAT( / 5X, A6, ' with SIDE = ''', A1, ''', TRANS = ''', A1,
474     $      ''', ', A1, ' =', I6, / )
475 9995 FORMAT( / 5X, 'ILO = 1, IHI = N', / )
476 9994 FORMAT( / 5X, 'ILO = 1, IHI = M if SIDE = ''L''', / 5X,
477     $      '             = N if SIDE = ''R''' )
478      RETURN
479*
480*     End of STIMHR
481*
482      END
483