tests/ctags/dopbl2.f

   1 ! Bug reported by Brian Helinski <bjh@absoft.com> on 4 Feb 2003
   2       DOUBLE PRECISION FUNCTION DOPBL2( SUBNAM, M, N, KKL, KKU )
   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 *     June 30, 1999
   8 *
   9 *     .. Scalar Arguments ..
  10       CHARACTER*6        SUBNAM
  11       INTEGER            KKL, KKU, M, N
  12 *     ..
  13 *
  14 *  Purpose
  15 *  =======
  16 *
  17 *  DOPBL2 computes an approximation of the number of floating point
  18 *  operations used by a subroutine SUBNAM with the given values
  19 *  of the parameters M, N, KL, and KU.
  20 *
  21 *  This version counts operations for the Level 2 BLAS.
  22 *
  23 *  Arguments
  24 *  =========
  25 *
  26 *  SUBNAM  (input) CHARACTER*6
  27 *          The name of the subroutine.
  28 *
  29 *  M       (input) INTEGER
  30 *          The number of rows of the coefficient matrix.  M >= 0.
  31 *
  32 *  N       (input) INTEGER
  33 *          The number of columns of the coefficient matrix.
  34 *          If the matrix is square (such as in a solve routine) then
  35 *          N is the number of right hand sides.  N >= 0.
  36 *
  37 *  KKL     (input) INTEGER
  38 *          The lower band width of the coefficient matrix.
  39 *          KL is set to max( 0, min( M-1, KKL ) ).
  40 *
  41 *  KKU     (input) INTEGER
  42 *          The upper band width of the coefficient matrix.
  43 *          KU is set to max( 0, min( N-1, KKU ) ).
  44 *
  45 *  =====================================================================
  46 *
  47 *     .. Local Scalars ..
  48       CHARACTER          C1
  49       CHARACTER*2        C2
  50       CHARACTER*3        C3
  51       DOUBLE PRECISION   ADDS, EK, EM, EN, KL, KU, MULTS
  52 *     ..
  53 *     .. External Functions ..
  54       LOGICAL            LSAME, LSAMEN
  55       EXTERNAL           LSAME, LSAMEN
  56 *     ..
  57 *     .. Intrinsic Functions ..
  58       INTRINSIC          MAX, MIN
  59 *     ..
  60 *     .. Executable Statements ..
  61 *
  62 *     Quick return if possible
  63 *
  64       IF( M.LE.0 .OR. .NOT.( LSAME( SUBNAM, 'S' ) .OR. LSAME( SUBNAM,
  65      $    'D' ) .OR. LSAME( SUBNAM, 'C' ) .OR. LSAME( SUBNAM, 'Z' ) ) )
  66      $     THEN
  67          DOPBL2 = 0
  68          RETURN
  69       END IF
  70 *
  71       C1 = SUBNAM( 1: 1 )
  72       C2 = SUBNAM( 2: 3 )
  73       C3 = SUBNAM( 4: 6 )
  74       MULTS = 0
  75       ADDS = 0
  76       KL = MAX( 0, MIN( M-1, KKL ) )
  77       KU = MAX( 0, MIN( N-1, KKU ) )
  78       EM = M
  79       EN = N
  80       EK = KL
  81 *
  82 *     -------------------------------
  83 *     Matrix-vector multiply routines
  84 *     -------------------------------
  85 *
  86       IF( LSAMEN( 3, C3, 'MV ' ) ) THEN
  87 *
  88          IF( LSAMEN( 2, C2, 'GE' ) ) THEN
  89 *
  90             MULTS = EM*( EN+1.D0 )
  91             ADDS = EM*EN
  92 *
  93 *        Assume M <= N + KL and KL < M
  94 *               N <= M + KU and KU < N
  95 *        so that the zero sections are triangles.
  96 *
  97          ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
  98 *
  99             MULTS = EM*( EN+1.D0 ) - ( EM-1.D0-KL )*( EM-KL ) / 2.D0 -
 100      $              ( EN-1.D0-KU )*( EN-KU ) / 2.D0
 101             ADDS = EM*( EN+1.D0 ) - ( EM-1.D0-KL )*( EM-KL ) / 2.D0 -
 102      $             ( EN-1.D0-KU )*( EN-KU ) / 2.D0
 103 *
 104          ELSE IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) .OR.
 105      $            LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
 106      $            LSAMEN( 3, SUBNAM, 'ZHE' ) .OR.
 107      $            LSAMEN( 3, SUBNAM, 'CHP' ) .OR.
 108      $            LSAMEN( 3, SUBNAM, 'ZHP' ) ) THEN
 109 *
 110             MULTS = EM*( EM+1.D0 )
 111             ADDS = EM*EM
 112 *
 113          ELSE IF( LSAMEN( 2, C2, 'SB' ) .OR.
 114      $            LSAMEN( 3, SUBNAM, 'CHB' ) .OR.
 115      $            LSAMEN( 3, SUBNAM, 'ZHB' ) ) THEN
 116 *
 117             MULTS = EM*( EM+1.D0 ) - ( EM-1.D0-EK )*( EM-EK )
 118             ADDS = EM*EM - ( EM-1.D0-EK )*( EM-EK )
 119 *
 120          ELSE IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) )
 121      $             THEN
 122 *
 123             MULTS = EM*( EM+1.D0 ) / 2.D0
 124             ADDS = ( EM-1.D0 )*EM / 2.D0
 125 *
 126          ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
 127 *
 128             MULTS = EM*( EM+1.D0 ) / 2.D0 -
 129      $              ( EM-EK-1.D0 )*( EM-EK ) / 2.D0
 130             ADDS = ( EM-1.D0 )*EM / 2.D0 -
 131      $             ( EM-EK-1.D0 )*( EM-EK ) / 2.D0
 132 *
 133          END IF
 134 *
 135 *     ---------------------
 136 *     Matrix solve routines
 137 *     ---------------------
 138 *
 139       ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN
 140 *
 141          IF( LSAMEN( 2, C2, 'TR' ) .OR. LSAMEN( 2, C2, 'TP' ) ) THEN
 142 *
 143             MULTS = EM*( EM+1.D0 ) / 2.D0
 144             ADDS = ( EM-1.D0 )*EM / 2.D0
 145 *
 146          ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
 147 *
 148             MULTS = EM*( EM+1.D0 ) / 2.D0 -
 149      $              ( EM-EK-1.D0 )*( EM-EK ) / 2.D0
 150             ADDS = ( EM-1.D0 )*EM / 2.D0 -
 151      $             ( EM-EK-1.D0 )*( EM-EK ) / 2.D0
 152 *
 153          END IF
 154 *
 155 *     ----------------
 156 *     Rank-one updates
 157 *     ----------------
 158 *
 159       ELSE IF( LSAMEN( 3, C3, 'R  ' ) ) THEN
 160 *
 161          IF( LSAMEN( 3, SUBNAM, 'SGE' ) .OR.
 162      $       LSAMEN( 3, SUBNAM, 'DGE' ) ) THEN
 163 *
 164             MULTS = EM*EN + MIN( EM, EN )
 165             ADDS = EM*EN
 166 *
 167          ELSE IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) .OR.
 168      $            LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
 169      $            LSAMEN( 3, SUBNAM, 'CHP' ) .OR.
 170      $            LSAMEN( 3, SUBNAM, 'ZHE' ) .OR.
 171      $            LSAMEN( 3, SUBNAM, 'ZHP' ) ) THEN
 172 *
 173             MULTS = EM*( EM+1.D0 ) / 2.D0 + EM
 174             ADDS = EM*( EM+1.D0 ) / 2.D0
 175 *
 176          END IF
 177 *
 178       ELSE IF( LSAMEN( 3, C3, 'RC ' ) .OR. LSAMEN( 3, C3, 'RU ' ) ) THEN
 179 *
 180          IF( LSAMEN( 3, SUBNAM, 'CGE' ) .OR.
 181      $       LSAMEN( 3, SUBNAM, 'ZGE' ) ) THEN
 182 *
 183             MULTS = EM*EN + MIN( EM, EN )
 184             ADDS = EM*EN
 185 *
 186          END IF
 187 *
 188 *     ----------------
 189 *     Rank-two updates
 190 *     ----------------
 191 *
 192       ELSE IF( LSAMEN( 3, C3, 'R2 ' ) ) THEN
 193          IF( LSAMEN( 2, C2, 'SY' ) .OR. LSAMEN( 2, C2, 'SP' ) .OR.
 194      $       LSAMEN( 3, SUBNAM, 'CHE' ) .OR.
 195      $       LSAMEN( 3, SUBNAM, 'CHP' ) .OR.
 196      $       LSAMEN( 3, SUBNAM, 'ZHE' ) .OR.
 197      $       LSAMEN( 3, SUBNAM, 'ZHP' ) ) THEN
 198 *
 199             MULTS = EM*( EM+1.D0 ) + 2.D0*EM
 200             ADDS = EM*( EM+1.D0 )
 201 *
 202          END IF
 203       END IF
 204 *
 205 *     ------------------------------------------------
 206 *     Compute the total number of operations.
 207 *     For real and double precision routines, count
 208 *        1 for each multiply and 1 for each add.
 209 *     For complex and complex*16 routines, count
 210 *        6 for each multiply and 2 for each add.
 211 *     ------------------------------------------------
 212 *
 213       IF( LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' ) ) THEN
 214 *
 215          DOPBL2 = MULTS + ADDS
 216 *
 217       ELSE
 218 *
 219          DOPBL2 = 6*MULTS + 2*ADDS
 220 *
 221       END IF
 222 *
 223       RETURN
 224 *
 225 *     End of DOPBL2
 226 *
 227       END