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