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