1      DOUBLE PRECISION FUNCTION DOPBL3( SUBNAM, M, N, K )
2*
3*  -- LAPACK timing routine (version 3.0) --
4*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5*     Courant Institute, Argonne National Lab, and Rice University
6*     June 30, 1999
7*
8*     .. Scalar Arguments ..
9      CHARACTER*6        SUBNAM
10      INTEGER            K, M, N
11*     ..
12*
13*  Purpose
14*  =======
15*
16*  DOPBL3 computes an approximation of the number of floating point
17*  operations used by a subroutine SUBNAM with the given values
18*  of the parameters M, N, and K.
19*
20*  This version counts operations for the Level 3 BLAS.
21*
22*  Arguments
23*  =========
24*
25*  SUBNAM  (input) CHARACTER*6
26*          The name of the subroutine.
27*
28*  M       (input) INTEGER
29*  N       (input) INTEGER
30*  K       (input) INTEGER
31*          M, N, and K contain parameter values used by the Level 3
32*          BLAS.  The output matrix is always M x N or N x N if
33*          symmetric, but K has different uses in different
34*          contexts.  For example, in the matrix-matrix multiply
35*          routine, we have
36*             C = A * B
37*          where C is M x N, A is M x K, and B is K x N.
38*          In xSYMM, xTRMM, and xTRSM, K indicates whether the matrix
39*          A is applied on the left or right.  If K <= 0, the matrix
40*          is applied on the left, if K > 0, on the right.
41*
42*  =====================================================================
43*
44*     .. Local Scalars ..
45      CHARACTER          C1
46      CHARACTER*2        C2
47      CHARACTER*3        C3
48      DOUBLE PRECISION   ADDS, EK, EM, EN, MULTS
49*     ..
50*     .. External Functions ..
51      LOGICAL            LSAME, LSAMEN
52      EXTERNAL           LSAME, LSAMEN
53*     ..
54*     .. Executable Statements ..
55*
56*     Quick return if possible
57*
58      IF( M.LE.0 .OR. .NOT.( LSAME( SUBNAM, 'S' ) .OR. LSAME( SUBNAM,
59     $    'D' ) .OR. LSAME( SUBNAM, 'C' ) .OR. LSAME( SUBNAM, 'Z' ) ) )
60     $     THEN
61         DOPBL3 = 0
62         RETURN
63      END IF
64*
65      C1 = SUBNAM( 1: 1 )
66      C2 = SUBNAM( 2: 3 )
67      C3 = SUBNAM( 4: 6 )
68      MULTS = 0
69      ADDS = 0
70      EM = M
71      EN = N
72      EK = K
73*
74*     ----------------------
75*     Matrix-matrix products
76*        assume beta = 1
77*     ----------------------
78*
79      IF( LSAMEN( 3, C3, 'MM ' ) ) THEN
80*
81         IF( LSAMEN( 2, C2, 'GE' ) ) THEN
82*
83            MULTS = EM*EK*EN
84            ADDS = EM*EK*EN
85*
86         ELSE IF( LSAMEN( 2, C2, 'SY' ) .OR.
87     $            LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
88     $            LSAMEN( 3, SUBNAM, 'ZHE' ) ) THEN
89*
90*           IF K <= 0, assume A multiplies B on the left.
91*
92            IF( K.LE.0 ) THEN
93               MULTS = EM*EM*EN
94               ADDS = EM*EM*EN
95            ELSE
96               MULTS = EM*EN*EN
97               ADDS = EM*EN*EN
98            END IF
99*
100         ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN
101*
102            IF( K.LE.0 ) THEN
103               MULTS = EN*EM*( EM+1.D0 ) / 2.D0
104               ADDS = EN*EM*( EM-1.D0 ) / 2.D0
105            ELSE
106               MULTS = EM*EN*( EN+1.D0 ) / 2.D0
107               ADDS = EM*EN*( EN-1.D0 ) / 2.D0
108            END IF
109*
110         END IF
111*
112*     ------------------------------------------------
113*     Rank-K update of a symmetric or Hermitian matrix
114*     ------------------------------------------------
115*
116      ELSE IF( LSAMEN( 3, C3, 'RK ' ) ) THEN
117*
118         IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
119     $       LSAMEN( 3, SUBNAM, 'ZHE' ) ) THEN
120*
121            MULTS = EK*EM*( EM+1.D0 ) / 2.D0
122            ADDS = EK*EM*( EM+1.D0 ) / 2.D0
123         END IF
124*
125*     ------------------------------------------------
126*     Rank-2K update of a symmetric or Hermitian matrix
127*     ------------------------------------------------
128*
129      ELSE IF( LSAMEN( 3, C3, 'R2K' ) ) THEN
130*
131         IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
132     $       LSAMEN( 3, SUBNAM, 'ZHE' ) ) THEN
133*
134            MULTS = EK*EM*EM
135            ADDS = EK*EM*EM + EM
136         END IF
137*
138*     -----------------------------------------
139*     Solving system with many right hand sides
140*     -----------------------------------------
141*
142      ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'TRSM ' ) ) THEN
143*
144         IF( K.LE.0 ) THEN
145            MULTS = EN*EM*( EM+1.D0 ) / 2.D0
146            ADDS = EN*EM*( EM-1.D0 ) / 2.D0
147         ELSE
148            MULTS = EM*EN*( EN+1.D0 ) / 2.D0
149            ADDS = EM*EN*( EN-1.D0 ) / 2.D0
150         END IF
151*
152      END IF
153*
154*     ------------------------------------------------
155*     Compute the total number of operations.
156*     For real and double precision routines, count
157*        1 for each multiply and 1 for each add.
158*     For complex and complex*16 routines, count
159*        6 for each multiply and 2 for each add.
160*     ------------------------------------------------
161*
162      IF( LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' ) ) THEN
163*
164         DOPBL3 = MULTS + ADDS
165*
166      ELSE
167*
168         DOPBL3 = 6*MULTS + 2*ADDS
169*
170      END IF
171*
172      RETURN
173*
174*     End of DOPBL3
175*
176      END
177