1      SUBROUTINE DPRTB3( LAB1, LAB2, NK, KVAL, LVAL, NN, NVAL, NLDA,
2     $                   RESLTS, LDR1, LDR2, NOUT )
3*
4*  -- LAPACK timing routine (version 3.0) --
5*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
6*     Courant Institute, Argonne National Lab, and Rice University
7*     March 31, 1993
8*
9*     .. Scalar Arguments ..
10      CHARACTER*( * )    LAB1, LAB2
11      INTEGER            LDR1, LDR2, NK, NLDA, NN, NOUT
12*     ..
13*     .. Array Arguments ..
14      INTEGER            KVAL( NK ), LVAL( NK ), NVAL( NN )
15      DOUBLE PRECISION   RESLTS( LDR1, LDR2, * )
16*     ..
17*
18*  Purpose
19*  =======
20*
21*  DPRTB3 prints a table of timing data for the timing programs.
22*  The table has NK block rows and NN columns, with NLDA
23*  individual rows in each block row.  Each block row depends on two
24*  parameters K and L, specified as an ordered pair in the arrays KVAL
25*  and LVAL.
26*
27*  Arguments
28*  =========
29*
30*  LAB1    (input) CHARACTER*(*)
31*          The label for the rows.
32*
33*  LAB2    (input) CHARACTER*(*)
34*          The label for the columns.
35*
36*  NK      (input) INTEGER
37*          The number of values of KVAL, and also the number of block
38*          rows of the table.
39*
40*  KVAL    (input) INTEGER array, dimension (NK)
41*          The values of the parameter K.  Each block row depends on
42*          the pair of parameters (K, L).
43*
44*  LVAL    (input) INTEGER array, dimension (NK)
45*          The values of the parameter L.  Each block row depends on
46*          the pair of parameters (K, L).
47*
48*  NN      (input) INTEGER
49*          The number of values of NVAL, and also the number of columns
50*          of the table.
51*
52*  NVAL    (input) INTEGER array, dimension (NN)
53*          The values of N used for the data in each column.
54*
55*  NLDA    (input) INTEGER
56*          The number of values of LDA, hence the number of rows for
57*          each value of KVAL.
58*
59*  RESLTS  (input) DOUBLE PRECISION array, dimension (LDR1, LDR2, NLDA)
60*          The timing results for each value of N, K, and LDA.
61*
62*  LDR1    (input) INTEGER
63*          The first dimension of RESLTS.  LDR1 >= max(1,NK).
64*
65*  LDR2    (input) INTEGER
66*          The second dimension of RESLTS.  LDR2 >= max(1,NN).
67*
68*  NOUT    (input) INTEGER
69*          The unit number on which the table is to be printed.
70*          NOUT >= 0.
71*
72*  =====================================================================
73*
74*     .. Local Scalars ..
75      INTEGER            I, J, K
76*     ..
77*     .. Executable Statements ..
78*
79      IF( NOUT.LE.0 )
80     $   RETURN
81      WRITE( NOUT, FMT = 9999 )LAB2, ( NVAL( I ), I = 1, NN )
82      WRITE( NOUT, FMT = 9998 )LAB1
83*
84      DO 20 I = 1, NK
85         IF( LAB1.EQ.' ' ) THEN
86            WRITE( NOUT, FMT = 9996 )( RESLTS( 1, J, 1 ), J = 1, NN )
87         ELSE
88            WRITE( NOUT, FMT = 9997 )KVAL( I ), LVAL( I ),
89     $         ( RESLTS( I, J, 1 ), J = 1, NN )
90         END IF
91         DO 10 K = 2, NLDA
92            WRITE( NOUT, FMT = 9996 )( RESLTS( I, J, K ), J = 1, NN )
93   10    CONTINUE
94         IF( NLDA.GT.1 )
95     $      WRITE( NOUT, FMT = * )
96   20 CONTINUE
97      IF( NLDA.EQ.1 )
98     $   WRITE( NOUT, FMT = * )
99      RETURN
100*
101 9999 FORMAT( 10X, A4, I7, 11I8 )
102 9998 FORMAT( 1X, A11 )
103 9997 FORMAT( 1X, '(', I4, ',', I4, ') ', 12F8.1 )
104 9996 FORMAT( 13X, 12F8.1 )
105*
106*     End of DPRTB3
107*
108      END
109