1      DOUBLE PRECISION FUNCTION DOPLA( SUBNAM, M, N, KL, KU, NB )
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            KL, KU, M, N, NB
11*     ..
12*
13*  Purpose
14*  =======
15*
16*  DOPLA computes an approximation of the number of floating point
17*  operations used by the subroutine SUBNAM with the given values
18*  of the parameters M, N, KL, KU, and NB.
19*
20*  This version counts operations for the LAPACK subroutines.
21*
22*  Arguments
23*  =========
24*
25*  SUBNAM  (input) CHARACTER*6
26*          The name of the subroutine.
27*
28*  M       (input) INTEGER
29*          The number of rows of the coefficient matrix.  M >= 0.
30*
31*  N       (input) INTEGER
32*          The number of columns of the coefficient matrix.
33*          For solve routine when the matrix is square,
34*          N is the number of right hand sides.  N >= 0.
35*
36*  KL      (input) INTEGER
37*          The lower band width of the coefficient matrix.
38*          If needed, 0 <= KL <= M-1.
39*          For xGEQRS, KL is the number of right hand sides.
40*
41*  KU      (input) INTEGER
42*          The upper band width of the coefficient matrix.
43*          If needed, 0 <= KU <= N-1.
44*
45*  NB      (input) INTEGER
46*          The block size.  If needed, NB >= 1.
47*
48*  Notes
49*  =====
50*
51*  In the comments below, the association is given between arguments
52*  in the requested subroutine and local arguments.  For example,
53*
54*  xGETRS:  N, NRHS  =>  M, N
55*
56*  means that arguments N and NRHS in DGETRS are passed to arguments
57*  M and N in this procedure.
58*
59*  =====================================================================
60*
61*     .. Local Scalars ..
62      LOGICAL            CORZ, SORD
63      CHARACTER          C1
64      CHARACTER*2        C2
65      CHARACTER*3        C3
66      INTEGER            I
67      DOUBLE PRECISION   ADDFAC, ADDS, EK, EM, EMN, EN, MULFAC, MULTS,
68     $                   WL, WU
69*     ..
70*     .. External Functions ..
71      LOGICAL            LSAME, LSAMEN
72      EXTERNAL           LSAME, LSAMEN
73*     ..
74*     .. Intrinsic Functions ..
75      INTRINSIC          MAX, MIN
76*     ..
77*     .. Executable Statements ..
78*
79*     --------------------------------------------------------
80*     Initialize DOPLA to 0 and do a quick return if possible.
81*     --------------------------------------------------------
82*
83      DOPLA = 0
84      MULTS = 0
85      ADDS = 0
86      C1 = SUBNAM( 1: 1 )
87      C2 = SUBNAM( 2: 3 )
88      C3 = SUBNAM( 4: 6 )
89      SORD = LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' )
90      CORZ = LSAME( C1, 'C' ) .OR. LSAME( C1, 'Z' )
91      IF( M.LE.0 .OR. .NOT.( SORD .OR. CORZ ) )
92     $   RETURN
93*
94*     ---------------------------------------------------------
95*     If the coefficient matrix is real, count each add as 1
96*     operation and each multiply as 1 operation.
97*     If the coefficient matrix is complex, count each add as 2
98*     operations and each multiply as 6 operations.
99*     ---------------------------------------------------------
100*
101      IF( LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' ) ) THEN
102         ADDFAC = 1
103         MULFAC = 1
104      ELSE
105         ADDFAC = 2
106         MULFAC = 6
107      END IF
108      EM = M
109      EN = N
110      EK = KL
111*
112*     ---------------------------------
113*     GE:  GEneral rectangular matrices
114*     ---------------------------------
115*
116      IF( LSAMEN( 2, C2, 'GE' ) ) THEN
117*
118*        xGETRF:  M, N  =>  M, N
119*
120         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
121            EMN = MIN( M, N )
122            ADDS = EMN*( EM*EN-( EM+EN )*( EMN+1.D0 ) / 2.D0+
123     $             ( EMN+1.D0 )*( 2.D0*EMN+1.D0 ) / 6.D0 )
124            MULTS = ADDS + EMN*( EM-( EMN+1.D0 ) / 2.D0 )
125*
126*        xGETRS:  N, NRHS  =>  M, N
127*
128         ELSE IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
129            MULTS = EN*EM*EM
130            ADDS = EN*( EM*( EM-1.D0 ) )
131*
132*        xGETRI:  N  =>  M
133*
134         ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN
135            MULTS = EM*( 5.D0 / 6.D0+EM*( 1.D0 / 2.D0+EM*( 2.D0 /
136     $              3.D0 ) ) )
137            ADDS = EM*( 5.D0 / 6.D0+EM*( -3.D0 / 2.D0+EM*( 2.D0 /
138     $             3.D0 ) ) )
139*
140*        xGEQRF or xGEQLF:  M, N  =>  M, N
141*
142         ELSE IF( LSAMEN( 3, C3, 'QRF' ) .OR.
143     $            LSAMEN( 3, C3, 'QR2' ) .OR.
144     $            LSAMEN( 3, C3, 'QLF' ) .OR. LSAMEN( 3, C3, 'QL2' ) )
145     $             THEN
146            IF( M.GE.N ) THEN
147               MULTS = EN*( ( ( 23.D0 / 6.D0 )+EM+EN / 2.D0 )+EN*
148     $                 ( EM-EN / 3.D0 ) )
149               ADDS = EN*( ( 5.D0 / 6.D0 )+EN*
150     $                ( 1.D0 / 2.D0+( EM-EN / 3.D0 ) ) )
151            ELSE
152               MULTS = EM*( ( ( 23.D0 / 6.D0 )+2.D0*EN-EM / 2.D0 )+EM*
153     $                 ( EN-EM / 3.D0 ) )
154               ADDS = EM*( ( 5.D0 / 6.D0 )+EN-EM / 2.D0+EM*
155     $                ( EN-EM / 3.D0 ) )
156            END IF
157*
158*        xGERQF or xGELQF:  M, N  =>  M, N
159*
160         ELSE IF( LSAMEN( 3, C3, 'RQF' ) .OR.
161     $            LSAMEN( 3, C3, 'RQ2' ) .OR.
162     $            LSAMEN( 3, C3, 'LQF' ) .OR. LSAMEN( 3, C3, 'LQ2' ) )
163     $             THEN
164            IF( M.GE.N ) THEN
165               MULTS = EN*( ( ( 29.D0 / 6.D0 )+EM+EN / 2.D0 )+EN*
166     $                 ( EM-EN / 3.D0 ) )
167               ADDS = EN*( ( 5.D0 / 6.D0 )+EM+EN*
168     $                ( -1.D0 / 2.D0+( EM-EN / 3.D0 ) ) )
169            ELSE
170               MULTS = EM*( ( ( 29.D0 / 6.D0 )+2.D0*EN-EM / 2.D0 )+EM*
171     $                 ( EN-EM / 3.D0 ) )
172               ADDS = EM*( ( 5.D0 / 6.D0 )+EM / 2.D0+EM*
173     $                ( EN-EM / 3.D0 ) )
174            END IF
175*
176*        xGEQPF: M, N => M, N
177*
178         ELSE IF( LSAMEN( 3, C3, 'QPF' ) ) THEN
179            EMN = MIN( M, N )
180            MULTS = 2*EN*EN + EMN*( 3*EM+5*EN+2*EM*EN-( EMN+1 )*
181     $              ( 4+EN+EM-( 2*EMN+1 ) / 3 ) )
182            ADDS = EN*EN + EMN*( 2*EM+EN+2*EM*EN-( EMN+1 )*
183     $             ( 2+EN+EM-( 2*EMN+1 ) / 3 ) )
184*
185*        xGEQRS or xGERQS:  M, N, NRHS  =>  M, N, KL
186*
187         ELSE IF( LSAMEN( 3, C3, 'QRS' ) .OR. LSAMEN( 3, C3, 'RQS' ) )
188     $             THEN
189            MULTS = EK*( EN*( 2.D0-EK )+EM*
190     $              ( 2.D0*EN+( EM+1.D0 ) / 2.D0 ) )
191            ADDS = EK*( EN*( 1.D0-EK )+EM*
192     $             ( 2.D0*EN+( EM-1.D0 ) / 2.D0 ) )
193*
194*        xGELQS or xGEQLS:  M, N, NRHS  =>  M, N, KL
195*
196         ELSE IF( LSAMEN( 3, C3, 'LQS' ) .OR. LSAMEN( 3, C3, 'QLS' ) )
197     $             THEN
198            MULTS = EK*( EM*( 2.D0-EK )+EN*
199     $              ( 2.D0*EM+( EN+1.D0 ) / 2.D0 ) )
200            ADDS = EK*( EM*( 1.D0-EK )+EN*
201     $             ( 2.D0*EM+( EN-1.D0 ) / 2.D0 ) )
202*
203*        xGEBRD:  M, N  =>  M, N
204*
205         ELSE IF( LSAMEN( 3, C3, 'BRD' ) ) THEN
206            IF( M.GE.N ) THEN
207               MULTS = EN*( 20.D0 / 3.D0+EN*
208     $                 ( 2.D0+( 2.D0*EM-( 2.D0 / 3.D0 )*EN ) ) )
209               ADDS = EN*( 5.D0 / 3.D0+( EN-EM )+EN*
210     $                ( 2.D0*EM-( 2.D0 / 3.D0 )*EN ) )
211            ELSE
212               MULTS = EM*( 20.D0 / 3.D0+EM*
213     $                 ( 2.D0+( 2.D0*EN-( 2.D0 / 3.D0 )*EM ) ) )
214               ADDS = EM*( 5.D0 / 3.D0+( EM-EN )+EM*
215     $                ( 2.D0*EN-( 2.D0 / 3.D0 )*EM ) )
216            END IF
217*
218*        xGEHRD:  N  =>  M
219*
220         ELSE IF( LSAMEN( 3, C3, 'HRD' ) ) THEN
221            IF( M.EQ.1 ) THEN
222               MULTS = 0.D0
223               ADDS = 0.D0
224            ELSE
225               MULTS = -13.D0 + EM*( -7.D0 / 6.D0+EM*
226     $                 ( 0.5D0+EM*( 5.D0 / 3.D0 ) ) )
227               ADDS = -8.D0 + EM*( -2.D0 / 3.D0+EM*
228     $                ( -1.D0+EM*( 5.D0 / 3.D0 ) ) )
229            END IF
230*
231         END IF
232*
233*     ----------------------------
234*     GB:  General Banded matrices
235*     ----------------------------
236*        Note:  The operation count is overestimated because
237*        it is assumed that the factor U fills in to the maximum
238*        extent, i.e., that its bandwidth goes from KU to KL + KU.
239*
240      ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
241*
242*        xGBTRF:  M, N, KL, KU  =>  M, N, KL, KU
243*
244         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
245            DO 10 I = MIN( M, N ), 1, -1
246               WL = MAX( 0, MIN( KL, M-I ) )
247               WU = MAX( 0, MIN( KL+KU, N-I ) )
248               MULTS = MULTS + WL*( 1.D0+WU )
249               ADDS = ADDS + WL*WU
250   10       CONTINUE
251*
252*        xGBTRS:  N, NRHS, KL, KU  =>  M, N, KL, KU
253*
254         ELSE IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
255            WL = MAX( 0, MIN( KL, M-1 ) )
256            WU = MAX( 0, MIN( KL+KU, M-1 ) )
257            MULTS = EN*( EM*( WL+1.D0+WU )-0.5D0*
258     $              ( WL*( WL+1.D0 )+WU*( WU+1.D0 ) ) )
259            ADDS = EN*( EM*( WL+WU )-0.5D0*
260     $             ( WL*( WL+1.D0 )+WU*( WU+1.D0 ) ) )
261*
262         END IF
263*
264*     --------------------------------------
265*     PO:  POsitive definite matrices
266*     PP:  Positive definite Packed matrices
267*     --------------------------------------
268*
269      ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'PP' ) ) THEN
270*
271*        xPOTRF:  N  =>  M
272*
273         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
274            MULTS = EM*( 1.D0 / 3.D0+EM*( 1.D0 / 2.D0+EM*( 1.D0 /
275     $              6.D0 ) ) )
276            ADDS = ( 1.D0 / 6.D0 )*EM*( -1.D0+EM*EM )
277*
278*        xPOTRS:  N, NRHS  =>  M, N
279*
280         ELSE IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
281            MULTS = EN*( EM*( EM+1.D0 ) )
282            ADDS = EN*( EM*( EM-1.D0 ) )
283*
284*        xPOTRI:  N  =>  M
285*
286         ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN
287            MULTS = EM*( 2.D0 / 3.D0+EM*( 1.D0+EM*( 1.D0 / 3.D0 ) ) )
288            ADDS = EM*( 1.D0 / 6.D0+EM*( -1.D0 / 2.D0+EM*( 1.D0 /
289     $             3.D0 ) ) )
290*
291         END IF
292*
293*     ------------------------------------
294*     PB:  Positive definite Band matrices
295*     ------------------------------------
296*
297      ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
298*
299*        xPBTRF:  N, K  =>  M, KL
300*
301         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
302            MULTS = EK*( -2.D0 / 3.D0+EK*( -1.D0+EK*( -1.D0 / 3.D0 ) ) )
303     $               + EM*( 1.D0+EK*( 3.D0 / 2.D0+EK*( 1.D0 / 2.D0 ) ) )
304            ADDS = EK*( -1.D0 / 6.D0+EK*( -1.D0 / 2.D0+EK*( -1.D0 /
305     $             3.D0 ) ) ) + EM*( EK / 2.D0*( 1.D0+EK ) )
306*
307*        xPBTRS:  N, NRHS, K  =>  M, N, KL
308*
309         ELSE IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
310            MULTS = EN*( ( 2*EM-EK )*( EK+1.D0 ) )
311            ADDS = EN*( EK*( 2*EM-( EK+1.D0 ) ) )
312*
313         END IF
314*
315*     ----------------------------------
316*     PT:  Positive definite Tridiagonal
317*     ----------------------------------
318*
319      ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
320*
321*        xPTTRF:  N  =>  M
322*
323         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
324            MULTS = 2*( EM-1 )
325            ADDS = EM - 1
326*
327*        xPTTRS:  N, NRHS  =>  M, N
328*
329         ELSE IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
330            MULTS = EN*( 3*EM-2 )
331            ADDS = EN*( 2*( EM-1 ) )
332*
333*        xPTSV:  N, NRHS  =>  M, N
334*
335         ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN
336            MULTS = 2*( EM-1 ) + EN*( 3*EM-2 )
337            ADDS = EM - 1 + EN*( 2*( EM-1 ) )
338         END IF
339*
340*     --------------------------------------------------------
341*     SY:  SYmmetric indefinite matrices
342*     SP:  Symmetric indefinite Packed matrices
343*     HE:  HErmitian indefinite matrices (complex only)
344*     HP:  Hermitian indefinite Packed matrices (complex only)
345*     --------------------------------------------------------
346*
347      ELSE IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) .OR.
348     $         LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
349     $         LSAMEN( 3, SUBNAM, 'ZHE' ) .OR.
350     $         LSAMEN( 3, SUBNAM, 'CHP' ) .OR.
351     $         LSAMEN( 3, SUBNAM, 'ZHP' ) ) THEN
352*
353*        xSYTRF:  N  =>  M
354*
355         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
356            MULTS = EM*( 10.D0 / 3.D0+EM*
357     $              ( 1.D0 / 2.D0+EM*( 1.D0 / 6.D0 ) ) )
358            ADDS = EM / 6.D0*( -1.D0+EM*EM )
359*
360*        xSYTRS:  N, NRHS  =>  M, N
361*
362         ELSE IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
363            MULTS = EN*EM*EM
364            ADDS = EN*( EM*( EM-1.D0 ) )
365*
366*        xSYTRI:  N  =>  M
367*
368         ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN
369            MULTS = EM*( 2.D0 / 3.D0+EM*EM*( 1.D0 / 3.D0 ) )
370            ADDS = EM*( -1.D0 / 3.D0+EM*EM*( 1.D0 / 3.D0 ) )
371*
372*        xSYTRD, xSYTD2:  N  =>  M
373*
374         ELSE IF( LSAMEN( 3, C3, 'TRD' ) .OR. LSAMEN( 3, C3, 'TD2' ) )
375     $             THEN
376            IF( M.EQ.1 ) THEN
377               MULTS = 0.D0
378               ADDS = 0.D0
379            ELSE
380               MULTS = -15.D0 + EM*( -1.D0 / 6.D0+EM*
381     $                 ( 5.D0 / 2.D0+EM*( 2.D0 / 3.D0 ) ) )
382               ADDS = -4.D0 + EM*( -8.D0 / 3.D0+EM*
383     $                ( 1.D0+EM*( 2.D0 / 3.D0 ) ) )
384            END IF
385         END IF
386*
387*     -------------------
388*     Triangular matrices
389*     -------------------
390*
391      ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN
392*
393*        xTRTRS:  N, NRHS  =>  M, N
394*
395         IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
396            MULTS = EN*EM*( EM+1.D0 ) / 2.D0
397            ADDS = EN*EM*( EM-1.D0 ) / 2.D0
398*
399*        xTRTRI:  N  =>  M
400*
401         ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN
402            MULTS = EM*( 1.D0 / 3.D0+EM*( 1.D0 / 2.D0+EM*( 1.D0 /
403     $              6.D0 ) ) )
404            ADDS = EM*( 1.D0 / 3.D0+EM*( -1.D0 / 2.D0+EM*( 1.D0 /
405     $             6.D0 ) ) )
406*
407         END IF
408*
409      ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
410*
411*        xTBTRS:  N, NRHS, K  =>  M, N, KL
412*
413         IF( LSAMEN( 3, C3, 'TRS' ) ) THEN
414            MULTS = EN*( EM*( EM+1.D0 ) / 2.D0-( EM-EK-1.D0 )*
415     $              ( EM-EK ) / 2.D0 )
416            ADDS = EN*( EM*( EM-1.D0 ) / 2.D0-( EM-EK-1.D0 )*( EM-EK ) /
417     $             2.D0 )
418         END IF
419*
420*     --------------------
421*     Trapezoidal matrices
422*     --------------------
423*
424      ELSE IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
425*
426*        xTZRQF:  M, N => M, N
427*
428         IF( LSAMEN( 3, C3, 'RQF' ) ) THEN
429            EMN = MIN( M, N )
430            MULTS = 3*EM*( EN-EM+1 ) + ( 2*EN-2*EM+3 )*
431     $              ( EM*EM-EMN*( EMN+1 ) / 2 )
432            ADDS = ( EN-EM+1 )*( EM+2*EM*EM-EMN*( EMN+1 ) )
433         END IF
434*
435*     -------------------
436*     Orthogonal matrices
437*     -------------------
438*
439      ELSE IF( ( SORD .AND. LSAMEN( 2, C2, 'OR' ) ) .OR.
440     $         ( CORZ .AND. LSAMEN( 2, C2, 'UN' ) ) ) THEN
441*
442*        -MQR, -MLQ, -MQL, or -MRQ:  M, N, K, SIDE  =>  M, N, KL, KU
443*           where KU<= 0 indicates SIDE = 'L'
444*           and   KU> 0  indicates SIDE = 'R'
445*
446         IF( LSAMEN( 3, C3, 'MQR' ) .OR. LSAMEN( 3, C3, 'MLQ' ) .OR.
447     $       LSAMEN( 3, C3, 'MQL' ) .OR. LSAMEN( 3, C3, 'MRQ' ) ) THEN
448            IF( KU.LE.0 ) THEN
449               MULTS = EK*EN*( 2.D0*EM+2.D0-EK )
450               ADDS = EK*EN*( 2.D0*EM+1.D0-EK )
451            ELSE
452               MULTS = EK*( EM*( 2.D0*EN-EK )+
453     $                 ( EM+EN+( 1.D0-EK ) / 2.D0 ) )
454               ADDS = EK*EM*( 2.D0*EN+1.D0-EK )
455            END IF
456*
457*        -GQR or -GQL:  M, N, K  =>  M, N, KL
458*
459         ELSE IF( LSAMEN( 3, C3, 'GQR' ) .OR. LSAMEN( 3, C3, 'GQL' ) )
460     $             THEN
461            MULTS = EK*( -5.D0 / 3.D0+( 2.D0*EN-EK )+
462     $              ( 2.D0*EM*EN+EK*( ( 2.D0 / 3.D0 )*EK-EM-EN ) ) )
463            ADDS = EK*( 1.D0 / 3.D0+( EN-EM )+
464     $             ( 2.D0*EM*EN+EK*( ( 2.D0 / 3.D0 )*EK-EM-EN ) ) )
465*
466*        -GLQ or -GRQ:  M, N, K  =>  M, N, KL
467*
468         ELSE IF( LSAMEN( 3, C3, 'GLQ' ) .OR. LSAMEN( 3, C3, 'GRQ' ) )
469     $             THEN
470            MULTS = EK*( -2.D0 / 3.D0+( EM+EN-EK )+
471     $              ( 2.D0*EM*EN+EK*( ( 2.D0 / 3.D0 )*EK-EM-EN ) ) )
472            ADDS = EK*( 1.D0 / 3.D0+( EM-EN )+
473     $             ( 2.D0*EM*EN+EK*( ( 2.D0 / 3.D0 )*EK-EM-EN ) ) )
474*
475         END IF
476*
477      END IF
478*
479      DOPLA = MULFAC*MULTS + ADDFAC*ADDS
480*
481      RETURN
482*
483*     End of DOPLA
484*
485      END
486